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PREFACE 


This  report  describes  the  modifications  which  were  incorporated  into 
the  Phase  III*  Calspan  Three-Dimensional  Crash  Victim  Simulation  Program  to  sat- 
isfy current  Air  Force  requirements. 

Three  principal  modifications  are: 

1.  Improved  Joint  Formulation 

2.  Improved  Belt  Formulation 

3.  Inclusion  of  Aerodynamic  Forces. 

The  modifications  have  been  made  so  that  they  may  be  used  on  the  CDC6600 
computer  at  the  Mathematics  and  Analysis  Branch  of  AMRL. 

The  research  effort  summarized  in  this  report  was  performed  for  the 
Aerospace  Medical  Research  Laboratory  [FY8990]  under  Contract  No.  Calspan  F33615-75- 
C-5002.  Dr.  John  T.  Fleck  of  the  Computer  Mathematics  Department  of  Calspan  served 
as  principal  investigator. 

The  authors  wish  to  thank  Ints  Kaleps  of  the  Aerospace  Medical  Research 
Laboratory  for  his  suggestions  and  direction  during  the  analytical  development  of  the 
program . 


*Phase  III  was  sponsored  by  the  National  Highway  Traffic  Safety  Administration, 
Department  of  Transportation.  The  ground  work  for  the  simulation  was  performed 
in  Phases  I and  II,  both  jointly  sponsored  by  NHTSA  and  the  Motor  Vehicle  Manu- 
facturers Association. 
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Section  1 


INTRODUCTION 


The  Calspan  3-D  Crash  Victim  Simulation  Model  was  originally  developed 
to  study  human  body  dynamics  associated  with  automobile  accidents.  The  formulation, 
however,  is  quite  general,  giving  it  great  versatility  and  making  it  applicable  to 
many  studies  involving  human  body  dynamics.  Reference  1 contains  a complete  descrip- 
tion of  this  model. 

To  fit  the  specific  needs  of  the  Mathematics  and  Analysis  Branch  (BBM)  of 
the  Aerospace  Medical  Research  Laboratory  (AMRL) , three  principal  modifications  have 
been  made  to  the  program.  These  are:  an  improved  joint  formulation,  an  improved 

belt  restraint  formulation  and  the  inclusion  of  aerodynamic  forces. 

The  modifications  are  described  in  the  following  sections. 
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Section  2 


JOINT  ALGORITHM 


The  joint  routine,  subroutine  VISPR,  which  is  in  the  Calspan  3-D  Crash 
Victim  Model,  has  been  modified  to  provide  the  option  of  computing  the  flexure 
torque  as  a function  of  both  the  flexure  angle  (elevation)  and  azimuth  angle. 

NOMENCLATURE 


3x3  direction  cosine  matrix  specifying  the  orientation 
of  segment  m’s  local  reference  with  respect  to  the  inertial 
reference . 


T 3x3  direction  cosine  matrix  specifying  the  relative  orien- 

m , n 

tation  of  joint  n’s  local  reference  with  respect  to  the  local 
reference  of  segment  m. 


T 3x3  direction  cosine  matrix  specifying  the  relative  orien- 

tation of  joint’s  local  reference  systems,  T=I , the  identity 
matrix,  is  the  equilibrium  position. 


^ij  ij element  of  matrix  T. 

n 3x1  matrix  (vector)  specifying  the  location  of  joint  n as 

measured  in  segment  m’s  local  reference. 


x,y,z  used  to  designate  axes  of  a right  handed  coordinate  system 

x ,y  ,z  may  be  regarded  as  3 x 1 matrix  (vector)  which  is  of  unit  mag- 

m m m 

nitude  and  is  orthogonal . 
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NOMENCLATURE  (CONTINUED) 


0 flexure  angle  of  joint. 

'f  torsion  angle  of  joint. 

$ azimuth  angle  used  to  describe  flexure  torque  asymmetrically. 

^4  3x1  matrix  (vector)  of  unit  magnitude  used  to  designate  axis 

of  flexure. 

Joint  Routine 


JOINT 

REFERENCE 


FIGURE  1 Joint  Coordinate  System 


The  position  of  joint  n,  which  is  fixed  in  segment  m,  is  given  by  vector 
r^  n (see  Figure  1).  The  orientation  of  the  joint  with  respect  to  segment  m's  ref- 
erence system  is  given  by  the  direction  cosine  matrix  T . The  matrix  T is  com- 
J S J m^n  m,n 

puted  from  the  yaw  (about  Z)  , pitch  (about  Y)  , and  roll  (about  X)  angles,  which  are 
specified  on  input  along  with  the  vector  r^  ^ . 
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and  the  matrix 


Joint  n connects  segments  m and  n+1.  The  vector  r 

6 n+l,n 

T , are  determined  from  input  as  were  r and  T 
n+l,n  r m,n  m,n 


For  the  relative  orientation  of  the  joint  we  have 


TT  D = T D , 

m,n  m n+l,n  n+1 


1=1,  D _ (T  D ) 
n+l,n  n+1  m,n  m 

where  are  the  direction  cosine  matrices  specifying  the  orientation  of  the 
segments  and  T is  the  direction  cosine  matrix  specifying  the  relative  orientation 
of  the  joint,  and  where  A * is  the  transpose  of  A. 


T and  T , are  defined  so  that  the  equilibrium  position  of  the  joint 
m,n  n+l,n  nr 

occurs  when  T=I,  the  identity  matrix. 


Consider  the  following  figure 


FIGURE  2 Joint  Flexure 

The  angle,  0,  between  the  Z axes  of  the  joint  reference  systems  is  defined 

as  the  flexure  angle  of  the  joint.  The  angle,  (J),  between  the  projection  of  in 

the  X Y plane  and  the  X axis  is  defined  as  the  azimuth  angle.  A twist  (torsion) 
m m r m 6 

angle, y-,  may  be  defined  as  either  a rotation  about  Z^  or  a rotation  about  Z^. 
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If  the  joint  is  pinned  (hinge  joint),  the  pin  axis  is  taken  as  the  Y axis, 
hence  is  parallel  to  Y^  for  this  pinned  joint.  In  this  case,  (j)  may  either  be  0 
or  if  . 


Flexure 


The  axis  of  flexure, ^ , may  be  computed  as  the  vector  cross  product  of 

Z and  Z . 
m n 

That  is  m = Z ® Z / l Z <fl  Z . 

~ m n | m n I 

Note  that  when  0=0  or  0=  Tf  yJU  is  undefined.  The  case  0=Tfwill  not  be 
considered.  We  will  assume  that  O<0<  That  is,  any  flexure  angle  equal  or  greater 
thanlf  will  never  occur. 


The  direction  cosines  of  a vector  in  the  direction  of  Z^  with  respect  to 

joint  reference  m are  given  by  the  third  row  of  the  matrix  T (i.e.  the  third  row  of 

T is  a unit  vector  in  the  Z direction.) 

n 


We  have 

sin  0 cos  $ = T^i 

sin  6 sin  $ = T^2 

cos  0 ■ T33 


Hence 


0 = cos 


-1 


33 


f = 


if  0 M 


/ = 


where  T. . 
ij 


is  the  i 


element  of  the  matrix  T. 
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We  have. 


Define  the  matrix  which  represents  a rotation  of  0 about  the  axisy^ 
in  matrix  form,* 

+ (lyyc1)  cos  0 - sin  0/c® 


where 


® is  the  matrix 


yU&  = 


In  our  case,  = ~T32V*y  = T31  and/*z  = °* 

We  compute  the  restoring  torque  for  flexure,  f(0,$),  as  a function  of  the 
flexure  angle,  0,  and  the  azimuth,  $.  The  torque,  + f(0,$)//,  will  be  applied  to  seg- 
ment m and  the  torque, -f (0,$]^/,  will  be  applied  to  segment  n+1 . We  assume  that  when 
0=0,  f(0,$)  = 0,  hence  the  fact  that  $ andy^  are  undefined  in  this  case  will  be  of 
no  consequence. 


Representation  of  Flexure  Torque 

We  use  the  following  approximation  for  the  torque  function  f(0,(j)). 

The  function,  f(0,^),  is  represented  as  a continuous  or  tabular  function  of 
0 for  discrete  values  of  $. 

That  is,  f (0,On)=gn(O)  n=l,N 

and  where  $1  = -1T  , $2 » • • -$N*$N+i » ^n+I^  ^ are  equally  spaced  between  -T f and Tf  and 
it  is  assumed  that  f (0,Tf)=f (0, -Tf)  therefore  is  not  required.  (The  range  -Tf 

to  Tf  is  used  to  be  consistent  with  the  four  quadrant  arctan  routines,  which  are  used 
to  evaluate  (j).) 


* Reference  1,  Volume  1,  page  23. 
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The  value  of  N will  be  restricted  only  by  the  storage  one  is  willing  to 
allocate  and  the  computing  time  involved. 

The  function  g^  may  be  defined  as  the  m ^ degree  polynomial  in  (0-0o)  or 
as  a table.  (They  cannot  be  mixed,  i.e.  for  a particular  joint  all  g must  be  tabu- 
lar or  polynomial.) 

In  both  cases,  a deadband  may  be  specified,  i.e.  a 0^  is  given  and 

g (0)  = O if  0<0  . 

ton  n o 

For  intermediate  values  of  q)  (i . e . , S 4 (J)  < (J>  . ) , we  evaluate  f for  g and 

rv  *n  x Tn+1  ton 

for  gn+i  and  linearly  interpolate  on  $.  The  wrap  around  if  (j)>  (f)^  or  $4  is  treated 

consistently  (i.e.,  interpolate  between  g^  and  g^.) 

Twist  (Torsion) 


When  there  is  no  flexure,  i.e.  0=0,  the  twisty  is  easily  defined  as  the 


rotation  about  the  Z axis.  In  this  case 
m 


cos  y sin  y 0 

T=Tr7(-^)  = ! -sin  y cos  Y 0 


When  0 is  not  equal  to  zero,  we  may  think  of  first  twisting  about  and 
then  rotation  about  the  axis  ^ 

T=T/(  (0)Tz(vO 

or  we  may  first  rotate  about ju  and  then  twist  about  the  resultant  Z,  i.e.  Z^. 
T=TZ(^  )T^  (0) 


These  definitions  are  equivalent  and  thus  give  a unique  definition  of  the 
angle  't  . To  show  this,  we  expand  T as 


and  as 


T=T^(^v jj  1 + (I-yy y/  1)cosQ  - sine^i 
T=f  Ml^l1+(I- Ui  /<11)cose-sine/y18)Tz 
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where  tt  =T_,^/  , i.e.  the  axis  of  rotation  is  fixed  in  the  X , Y plane.  Substitu- 
- 1 Z'  m m 1 

ting  for  the  value  of  ^ ^ in  the  above  expression  shows  the  equivalence. 

Although  the  angle  y is  well  defined,  it  does  not  seem  possible  to  uniquely 
define  an  axis,  which  may  be  used  for  the  restoring  torque.  This  problem  exists  be- 
cause we  are  talking  about  a mathematical  definition  of  twist  and  not  a physical  de- 
scription of  a joint. 

The  program  has  been  coded  to  use  the  axis . The  magnitude  of  the  torque 
is  computed  by  the  standard  spring  function  characteristics  available  in  the  program. 
This  is  done  using  subroutine  EFUNCT. 

The  torque,  q,  is  computed  from  the  five  parameters  S^,S^,S^,S^  and  by 
the  following  algorithms. 

If  Y < s5 

q = 

If  ~P  > an  additional  torque  q^  is  computed  as 

is  ■ V’-'-V2  * S3(l--V3 

If  y < 0 (unloading)  q?  is  modified  by  qg  = S^q^ 

(If  is  equal  to  zero,  q^  is  not  computed  but  q is  modified  by  ) 

For  small  values  of  IY{  , (10  radians/sec),  the  routine  interpolates 
between  the  loading  and  unloading  characteristics. 

The  total  torque  q+q^  is  returned  as  the  function  value. 
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TORQUE 


1 


+s2(7-s5)2+s3(y  -S5)3 


yj  (RADIANS) 

FIGURE  3 JOINT  SPRING  TORQUE 
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Viscous  and  Coulomb  Torques 


Let  OJ  be  the  relative  angular  velocity.  A torque  is  computed  to  oppose 
this  velocity  using  the  standard  viscous  function  definition  in  the  program.  This 
is  illustrated  in  Figure  4. 


COULOMB 

TORQUE 


q/M  = Vx  + V2/(max(M  ,V3)) 

U)  is  the  relative  angular  velocity. 


VISCOUS 

TORQUE 


FIGURE  4 JOINT  TORQUE  DUE  TO  RELATIVE  ANGULAR  VELOCITY  AT  THE  JOINT 
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Section  3 


BELT  ALGORITHM 


The  belt  routine  in  Version  III  of  the  Calspan  3-D  program  is  restricted 
to  a simple  belt  passing  around  a single  segment.  Although  several  of  these  belts 
may  be  used,  no  provision  for  interaction  of  the  belts  was  made. 

To  overcome  this  restriction  and  to  satisfy  the  requirements  of  the  current 
contract,  an  entirely  new  belt  algorithm  has  been  developed  and  incorporated  into  the 
program. 


The  current  version  of  the  algorithm  assumes  each  belt  lies  essentially  in 
a plane  which  may  be  described  by  a set  of  reference  points  rigidly  attached  to  seg- 
ments. Thus,  its  use  should  be  restricted  to  harnesses  (several  belts  connected  at 
a common  junction  point)  which  constrain  the  segments  involved  from  large  relative 
motions . 


The  algorithm  should  lend  itself  to  significant  improvements  in  the  modeling 
of  harnesses . 

The  concept  of  a harness  is  introduced  in  this  version  of  the  program.  A 
harness  consists  of  from  one  to  several  belts.  Each  belt  is  defined  as  the  set  of 
straight  line  segments  connecting  prescribed  reference  points.  One  end  of  the  belt 
is  the  anchor  point  and  the  other  end  the  junction  point.  See  Figure  5 below. 


BELT  1 


FIGURE  5 BELT  HARNESS  MODEL 
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Each  reference  point  is  fixed  relative  to  a prescribed  segment.  An  ellip- 
soid is  assigned  to  each  reference  point.  The  ellipsoid  is  fixed  to  the  same  seg- 
ment as  the  reference  point.  Ellipsoids  associated  with  the  anchor  point  and  the 
junction  point  are  ignored  in  the  current  version  of  the  program  hence  may  be  speci- 
fied as  zero.  The  ellipsoid  is  used  to  determine  an  outward  normal  vector  to  the 
surface  of  the  ellipsoid  at  the  reference  point.  If  the  net  force  on  the  segment  at 
this  point  has  a positive  component  along  this  normal,  the  point  will  be  ignored  in 
computing  the  belt  length.  If  no  ellipsoid  is  specified  for  an  interior  point,  this 
point  will  always  be  used  in  computing  the  belt  length.  For  example,  see  Figure  6. 


Junction  Point 


FIGURE  6 BELT  LENGTH  SPECIFICATION 
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In  this  example,  the  belt  is  defined  by  the  10  reference  points  illustrated. 
Ellipsoids  associated  with  the  interior  points  are  represented  by  the  curved  lines. 

In  the  above  configuration,  the  belt  length  would  be  computed  as  the  sum  of  the  length 
of  the  lines  from  1 to  4,  4 to  8 and  8 to  10  as  illustrated  by  the  solid  lines. 

If  no  ellipsoid  were  specified  for  point  6,  the  belt  would  follow  the  dashed 

line,  1-4-5-6-8-10.  The  algorithm  determines  this  belt  configuration  in  the  following 
manner: 

1.  The  belt  is  first  assumed  to  go  from  point  1 to  point  2 to  point  3. 

2.  The  net  force  at  point  2 (assuming  constant  tension)  is  found  to  be 

directed  along  the  outward  normal  to  the  reference  ellipsoid  assigned 
to  point  2 hence  point  2 is  dropped  from  consideration. 

3.  The  belt  is  next  assumed  to  go  from  point  1 to  point  3 to  point  4. 

4.  This  is  the  same  situation  as  was  found  in  step  2 above  hence  point 
3 is  dropped. 

5.  The  belt  is  next  assumed  to  go  from  point  1 to  point  4 to  point  5. 

6.  The  net  force  at  point  4 is  directed  along  the  inward  normal  to  the 

ellipsoid  assigned  to  point  4 hence  point  4 is  accepted. 

7.  The  belt  is  next  assumed  to  go  from  point  4 (the  last  accepted  point) 

to  point  5 to  point  6. 

8.  The  net  force  at  point  5 is  found  to  be  directed  along  the  inward 
normal  to  the  ellipsoid  assigned  to  point  5 hence  point  5 is  accepted. 

9.  The  belt  is  next  assumed  to  go  from  point  5 to  point  6 to  point  7. 

10.  The  net  force  at  point  6 is  found  to  be  directed  along  the  outward 

normal  to  the  ellipsoid  assigned  to  point  6 hence  point  6 is  dropped 
from  consideration. 

11.  Point  5 was  accepted  because  4,5,6  were  acceptable,  since  6 is  now 
rejected  and  the  belt  is  assumed  to  go  from  4 to  5 to  7. 
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This  process  is  continued  resulting  in  the  following  condensed  steps. 


12. 

5 is  rejected. 

13. 

Try  4-7-8. 

14. 

7 rejected. 

15. 

Try  4-8-9. 

16. 

8 accepted. 

17. 

Try  8-9-10. 

18. 

9 rejected. 

19. 

Since  10  is  a junction  point,  the  final  belt  is  1-4-8-10 

Computation  of 

Belt  Tension 

The  strain  is  computed  as 

calculated  length  - reference  length 
strain  reference  length 

The  stress  (tension)  is  computed  by  the  standard  force  deflection  routines 
available  in  the  program  using  strain  as  the  deflection  parameter. 

The  current  version  of  the  program  assumes  that  the  tension  is  uniform  in 

the  belt. 
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Examples 


The  above  technique  provides  considerable  versatility  in  defining  belt 
systems.  For  example: 

SIMPLE  LAP  BELT  Anchor  Point 


FIGURE  7 Simple  Lap  Belt  Harness  Configuration 

Define  a harness  consisting  of  one  belt.  In  this  case,  the  junction  point 
is  actually  an  anchor  point.  All  interior  reference  points  are  attached  to  the  same 
segment  and  assigned  the  same  reference  ellipsoid. 

SHOULDER  BELT  AND  LAP  BELT 


FIGURE  8 Shoulder  Belt  and  Lap  Belt  Harness  Configuration 
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Define  a harness  consisting  of  three  belts  with  the  junction  points  attached 
to  a segment,  which  is  disjoint  (but  need  not  be)  from  the  body  segments.  This  seg- 
ment is  assigned  a mass  and  an  inertia  tensor  and  will  move  dynamically  to  achieve  a 
force  balance.  (we  recommend  that  the  junction  points  all  be  located  at  the  eg  of  the 
junction  segment  to  prevent  large  angular  accelerations.) 

The  Input  Description  of  the  program  contains  the  details  of  inputting  a 
belt  system. 

General  Comments 


Since  there  is  no  limitation  (except  storage)  on  the  number  of  harnesses, 
belts  or  reference  points,  quite  elaborate  belt  systems  may  be  modeled. 

The  program  is  so  written  that  it  may  be  modified  to  include  effects  of  belt 
friction  and  deformation  of  the  surface  at  the  reference  points.  For  example,  the 
reference  points  could  be  moved  along  the  normal  as  a function  of  the  normal  force. 

The  belt  is  not  constrained  to  lie  in  a plane.  The  algorithm,  as  illus- 
trated in  Figure  5 , was  designed  on  the  assumption  that  the  interior  reference  points 
lie  essentially  in  a plane.  Highly,  non  planar  sets  of  points  may  produce  unexpected 
results.  No  study  has  been  made  of  this  potential  problem  or  of  other  unusual  config- 
urations that  would  cause  the  algorithm  to  fail. 

The  computation  of  frictional  effects  and  deformation  is  complicated  by  the 
fact  that  a change  in  belt  position  or  tension  at  one  point  affect  all  the  points. 

Thus,  the  problem  would  require  the  use  of  techniques  such  as  finite  element  methods. 
However,  a first  approximation  to  the  effects  of  deformation  could  be  made  by  holding 
the  reference  points  fixed  during  the  course  of  an  integration  step  and  at  the  com- 
pletion of  a successful  integration  step  the  points  could  be  moved  along  the  normal 
(as  defined  by  the  reference  ellipsoid)  as  a function  of  the  normal  force  computed 
from  the  current  belt  configuration.  Alternately,  the  point  could  be  moved  in  the 
direction  of  the  net  force.  Storage  has  been  allocated  in  the  program  to  store  a 
fixed  reference  point  and  a modified  reference  point.  Perhaps  the  effects  of  fric- 
tion could  be  approximated  by  allowing  the  modified  reference  point  to  move  in  a di- 
rection other  than  along  the  normal.  Future  study  should  consider  these  possibilities. 
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Section  4 


AERODYNAMIC  FORCES 


Routines  have  been  added  to  the  program  to  allow  the  application  of  a 
specified  force  to  any  segment.  The  method  allows  any  force  to  act  on  any  segment. 

In  addition,  for  each  segment  a boundary  plane  is  specified  and  the  force  is  not 
applied  until  the  segment  penetrates  the  boundary  plane. 

An  aerodynamic  pressure,  a boundary  plane,  and  an  ellipsoid  are  associated 
with  each  segment  for  which  it  is  desired  to  compute  an  aerodynamic  force.  The  aero- 
dynamic pressure,  as  a function  of  time,  is  inputted  as  tabular  data. 

As  the  ellipsoid  penetrates  the  boundary  plane,  an  estimate  of  the  projected 
area  normal  to  the  pressure  is  made  and  the  force  and  torque  are  computed  and  applied 
to  the  segment.  For  partial  penetration,  the  force  is  applied  at  a point  in  the 
ellipsoid.  At  full  penetration,  the  force  is  applied  at  the  center  of  the  ellipsoid. 


MATHEMATICAL  FORMULATION 


Reference 

FIGURE  9 BOUNDARY  PLANE  PENETRATION  BY  ELLIPSOID 
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Let  y 
z 
b 

t 

P 

r 

t 

A 

/ 


location  of  reference  point  for  plane 
location  of  eg  of  segment 
offset  of  center  of  ellipsoid  from  eg 
penetration  distance 

unit  vector  describing  outward  normal  to  boundary  plane 
vector  from  center  of  ellipsoid  to  point  of  maximum  penetration 
distance  from  center  of  ellipsoid  to  point  of  maximum  penetration 
vector  describing  wind  (force  per  unit  area) 

matrix  defining  the  ellipsoid  (a  3x3  positive  definite  matrix.) 
distance  of  plane  from  its  reference  point 


We  have  the  following  equations: 

r • Ar=l  if  r is  on  the  ellipsoid 
p . r=- 

p • [z+b+r]=-/<^  +S+p*y 

Ar  vector  normal  to  ellipsoid  at  r. 


At  a given  instant  in  time  we  know  y,z,b,p,t  and  A. 


In  the  computer  program,  the  ellipsoid  matrix  is  a given  constant  in  the 
reference  system  of  the  segment.  All  quantities  are  first  converted  to  this  refer- 
ence system  for  ease  of  computation. 


COMPUTATION  OF  PENETRATION  DISTANCE 

If  r goes  to  the  point  of  maximum  penetration,  then 

Ar=c  p,  where  c is  some  constant 

since  r-Ar=l  if  r is  on  the  ellipsoid 

r=cA  *p 

, 2 -1  _ 
r*Ar=c  p*A  p=l 
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then  c= 1 / v p-A  *p 


and  r=A  ^pj 


H 


A-i 

p-A  p 


The  penetration  distance  S may  be  computed  as 


S =p- [z+b+r-y]-/  , 


and  may  be  computed  as 


cA 


If  <f  is  less  than  zero,  no  penetration  has  occurred. 

If  £ is  greater  than  2 °<  the  ellipsoid  has  fully  penetrated  the  plane. 


COMPUTATION  OF  PROJECTED  AREA 

If  penetration  has  occurred,  we  must  distinguish  between  three  cases  in 
the  computation  of  the  shadow  (projected)  area  of  the  ellipsoid  onto  the  plane. 
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Ae 


*/ 


L 


Full  ^-^1 

Shadotf^-y 

FIGURE  10  SHADOW  (PROJECTED)  AREA  OF  ELLIPSOID  ONTO  A PLANE 

Consider  the  above  figure  where  planes  E and  F are  parallel  to  the  boundary 
plane  p and  are  such  that  at  the  points  e and  f which  are  on  the  ellipsoid  and  in  the 
indicated  planes  we  have  t*Ae=0,  t*Af=0  and  the  planes  are  positioned  that  |p.e  | 
and  |p*f|  are  at  their  maximum  values  (i.e.  if  the  planes  were  moved  further  away 
from  the  center  of  the  ellipsoid,  no  such  points  could  be  found.) 


Consider  the  Three  Cases 

Case  I The  boundary  plane  is  above  plane  E but  still  intersects  the 
ellipsoid.  In  this  case,  the  projected  area  is  the  area  of  the  ellipsoid  formed 
by  the  intersection  with  the  plane  p projected  on  a plane  normal  to  t. 

Case  II  The  boundary  plane  is  between  planes  E and  F.  This  is  a region 
where  the  projected  area  is  made  up  of  parts  of  two  ellipses.  One  is  the  shadow 
ellipse  and  the  other  is  the  ellipse  formed  by  the  intersection  of  the  ellipsoid 
and  the  plane  p. 

Case  III  The  boundary  plane  is  below  plane  F.  In  this  case,  the  full 
shadow  ellipse  is  produced  and  does  not  alter  with  the  penetration  distance  or  orien- 
tation of  the  boundary  plane. 


23 


Computation  in  the  Above  Cases 


It  may  be  shown  that 

-1  2 1/2 
p.e=(p*A  p-(p't)  /t'At)  = -p.f 

Case  I This  case  exists  when  «S  > 0 andor  > p-e+<T 


The  center  of  the  ellipse  of  intersection  is  at  m where 
m=(c*  - S )A_1p/p*A  lp 


FIGURE  11  Intersection  Ellipsoid 


The  equation  of  a point  u on  this  ellipse  is 
u*  Bu=l 

where  u is  measured  from  the  center  of  the  ellipse  hence  lies  in  the  plane  of  inter- 
section, and 

B=  (I-pp  *)A(I-pp  •)/  (1-m.Am) 
m.Am=(^  -«S)^/p-A  *p 

The  matrix  B is  singular  (has  a zero  eigenvalue)  but  the  product  of  the  two 
non  zero  eigenvalues  is  the  reciprocal  of  the  square  of  the  product  of  the  major  and 
minor  axis  of  the  ellipse.  The  area  is  the  product  of  times  the  product  of  the 
major  and  minor  axes. 
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We  have 


2 2 

P = product  of  eigenvalues  = [(tr(B))  - tr(B  )]/2 

where  tr(B)  is  the  trace  (sum  of  diagonal  elements)  of  the  matrix  B. 

For  a matrix  such  as  B,  the  product  of  the  eigenvalues  can  most  readily  be  computed 
as  the  sum  of  the  principle  minors. 

Hence, 

1/2 

Area  =<rt  (l-m^Am)/p 

The  area  normal  to  t is  then  equal  to  |p*t|. 

The  point  of  force  application  will  be  taken  as  the  center  of  the  ellipse 
(i.e.  At  m) 


Case  III  Full  Shadow 

This  exists  when  </>0  and  S > p #e+<X=<^~ -p#f 


FIGURE  12  Full  Shadow 


At  point  u on  the  shadow  ellipsoidal  cone  is  measured  from  the  center  of  the 
ellipse  in  a plane  _L  to  t . 

u*C  u = 1 

where  C = A - At (At) */t 'At 

The  product  p of  the  nonzero  eigenvalues  is  the  sum  of  the  principle  minors 

1/2 

of  C.  The  projected  area  is  then  Area=<r//p 

The  force  is  applied  at  center  of  ellipsoid. 
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Case  II  Mixed  Region 


The  exact  calculation  here  is  involved  since  it  involves  the  computation 
of  areas  of  partial  ellipses.  Since  the  method  of  aerodynamic  force  computation  is 
only  an  approximation , we  decided  that  it  is  reasonable  to  compute  the  projected 
area  and  the  point  of  force  application  in  the  following  manner: 

1.  Referring  to  Figure  9,  ifc^  is  less  than  zero,  no  penetration  has 
occurred  so  no  aerodynamic  force  will  be  applied. 

2.  If  £ is  positive,  a scale  factor  is  computed  as  (Figure  10) 

Scale  = (o<-<T+  |p*e|  )/(<*+  |p*e|  ) 

If  scale  is  greater  than  one,  no  penetration  has  occurred  0). 

If  scale  is  less  than  zero,  the  ellipsoid  has  penetrated  enough  that 
Case  III  applies.  In  this  case,  scale  is  set  to  zero. 

3.  The  full  projected  Area  is  computed  by  the  formula  in  Case  III 
Area  =77,/p'^. 

The  effective  area  is  computed  as 

2 

Effective  Area  = (1-Scale  )*Area 

4.  The  point  of  force  application  is  computed  as 
q=Scale*r 

where  r is  the  vector  from  the  center  of  the  ellipsoid  to  the  point  of 
maximum  penetration  (see  Figure  9.) 

5.  The  aerodynamic  force  is  computed  by  interpolating  the  given  table 
of  pressure  for  the  proper  time  and  multiplying  this  pressure  by  the 
Area . 

6.  The  force  and  torque  are  then  applied  to  the  segment. 
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Section  5 
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APPENDIX  A 
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REV  12  12/19/74 

INPUT  DESCRIPTION  FOR  THE  CALSPAN  3-D  CRASH  VICTIM  SIMULATION  PROGRAM 
AS  SUPPLIED  TO  WRIGHT  PATTERSON  A.F.B.  (CONTRACT  NO.  F33615-75-C-5002 ) 

NOTE:  THIS  REPORT  IS  SUPPLIED  WITH  *1*  IN  COLUMN  1 FOR  PAGE  SKIP 
CONTROL  TO  ALLOW  FOR  PRINTING  ON  VARIOUS  COMPUTER  SYSTEMS. 

THE  FOLLOWING  SPECIAL  SYMBOLS  MAY  DIFFER  ON  OTHER  SYSTEMS: 

IS  USED  TO  INDICATE  "NOT  EQUAL". 

"<"  IS  USED  TO  INDICATE  "LESS  THAN". 

">"  IS  USED  TO  INDICATE  "GREATER  THAN". 

"I"  IS  USED  TO  INDICATE  "ABSOLUTE  VALUE". 


ANY  LINE  WITH  A "|"  AT  THE  RIGHT  INDICATES  A CHANGE  MADE  TO  THIS 
INPUT  DESCRIPTION  INCLUDED  IN  CALSPAN  REPORT  NO.  ZQ-5180-L-I  ENTITLED 
"AN  IMPROVED  THREE  DIMENSIONAL  COMPUTER  SIMULATION  OF  MOTOR  VEHICLE 
CRASH  VICTIMS"  (JULY  1974). 


OUTLINE  OF  INPUT  TO  THE  PROGRAM  : 


CARDS  A - DATE  AND  RUN  DESCRIPTION,  UNITS  OF  INPUT  AND  OUTPUT, 
CONTROL  OF  RESTART,  INTEGRATOR  AND  OPTIONAL  OUTPUT. 

CARDS  B - PHYSICAL  CHARACTERISTICS  OF  THE  SEGMENTS  AND  JOINTS. 

CARDS  C - DESCRIPTION  OF  THE  VEHICLE  MOTION. 

CARDS  D - CONTACT  PLANES,  BELTS,  AIR  BAGS,  CONTACT  ELLIPSOIDS, 
CONSTRAINTS,  AND  SYMMETRY  OPTIONS. 

CARDS  E - FUNCTIONS  DEFINING  FORCE-DEFLECTIONS,  INERITIAL  SPIKE, 
ENERGY  ABSORPTION  FACTOR,  AND  FRICTION  COEFFICIENTS. 

CARDS  F - ALLOWED  CONTACTS  AMONG  SEGMENTS,  PLANES,  BELTS,  AIR  BAGS 
AND  CONTACT  ELLIPSOIDS. 

CARDS  G - INITIAL  ORIENTATIONS  AND  VELOCITIES  OF  THE  SEGMENTS. 


CARDS  H 


CONTROL  OF  OUTPUT  OF  TIME  HISTORY  OF  SELECTED  SEGMENT 
MOTIONS  AND  JOINT  PARAMETERS. 
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A 


MAIN  PROGRAM  INPUT 


CARD  A. I. A 

FORMAT  (3AA,2IA,F8.0) 

DATE ( 1 ) , 1 = 1 ,3 

DATE  OF  THE  RUN  (12  CHARACTERS). 

IRSIN 

RESTART  INPUT  UNIT  NO.  IF  BLANK  OR  ZERO, 
ALL  INPUT  TO  BE  SUPPLIED  ON  CARDS  A.3  TO 
CARDS  H.7.  IF  NONZERO  (SUGGESTED  VALUE  = A) 
INPUT  WILL  BE  SUPPLIED  FROM  A PREVIOUS 
RESTART  TAPE  AND  CARDS  A.1.B,C  AND  A. 2. 

IRSOUT 

RESTART  OUTPUT  UNIT  NO.  IF  NONZERO  (SUGGESTED 
VALUE  =3)  RECORDS  WILL  BE  WRITTEN  ON  THIS 
OUTPUT  UNIT  FOR  FUTURE  RESTART  RUNS.  AN 
INITIAL  RECORD  CONTAINING  ALL  INPUT  AND 
INITIALIZATION  DATA  WILL  BE  WRITTEN  PLUS  A 
TIME  POINT  RECORD  AT  EVERY  TIME  INTERVAL  AS 
SPECIFIED  BY  DT  ON  CARD  A. A. 

RSTIME 

RESTART  TIME  (SEC.)  REQUIRED  IF  IRSIN  # 0. 
SHOULD  BE  NONZERO  AND  AN  INTEGER  MULTIPLE 
OF  DT  ON  CARD  A. A.  PROGRAM  WILL  READ  RECORDS 
FROM  THE  PREVIOUS  RESTART  TAPE  UP  TO  AND 
INCLUDING  THIS  TIME,  MAKE  CHANGES  PER  CARO 
A. 2 AND  CONTINUE  OPERATION  FROM  THERE. 

CARDS  A.l.B  - A.l.C 

FORMAT  (20AA/20AA) 

COM ENT (l),l=I,AO 

DESCRIPTION  OF  THE  RUN  (160  CHARACTERS  ON 
TWO  CARDS). 
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THESE  CARDS  REQUIRED  ONLY  IF  IRSIN  > 0 , IN  WHICH  CASE  ALL 
OTHER  INPUT  AS  SPECIFIED  ON  CARDS  A .3  TO  H.7  ARE  BYPASSED, 

TWO  SETS  OF  A. 2 (EACH  TERMINATED  WITH  A BLANK  CARD)  ARE  REQUIRED. 
THE  FIRST  SET  IS  PROCESSED  AFTER  THE  INITIAL  INPUT  RECORD  IS  READ 
FROM  INPUT  UNIT  IRSIN  AND,  IF  IRSOUT  # 0,  BEFORE  THE  INPUT 
RECORD  IS  WRITTEN  ON  OUTPUT  UNIT  IRSOUT.  THE  SECOND  SET  IS 
PROCESSED  AFTER  THE  TIME  POINT  RECORD  FOR  TIME  = RSTIME  HAS  BEEN 
READ  AND,  IF  IRSOUT  # 0,  AFTER  THE  SAME  RECORD  IS  WRITTEN  ON 
OUTPUT  UNIT  IRSOUT,  BUT  BEFORE  THE  PROGRAM  RESUMES  OPERATION. 


CARDS  A. 2. A - A.2.N  FORMATtAB,  414,  2(F8.0,  18,  A8)  ) 

AVAR  ALPHANUMERIC  NAME  (LEFT  ADJUSTED  IN  FIELD) 

OF  VARIABLE  TO  BE  REDEFINED  FOR  RESTART. 
PROGRAM  IS  CAPABLE  OF  CHANGING  ANY  VARIABLE 
IN  THE  LABELED  COMMON  BLOCKS  AS  USED  AFTER 
ALL  INITIALIZATION  HAS  BEEN  PERFORMED.  THE 
USER  SHOULD  ASCERTAIN  THAT  CHANGING  THIS 
VARIABLE  IS  VALID  FOR  THE  PROGRAM. 


TNDEXt I) ,1=1,3  THE  ARRAY  INDICES,  IF  ANY,  OF  THE  VARIABLE. 

MUST  AGREE  IN  NUMBER  AND  THE  VALUES  MUST  BE 
LESS  THAN  OR  EQUAL  TO  THE  DIMENSIONS  OF  THE 
VARIABLE.  BLANK  OR  ZERO  FOR  NO  DIMENSION. 


ITYPE  SUPPLY  1,2  OR  3 TO  INDICATE  THAT  THE  NEW 

VALUE  IS  TO  BE  REAL ( RR  ) , INTEGER (II)  OR 
ALPHANUMERIC(Aa).  MUST  AGREE  WITH  THE  TYPE 
OF  THE  VARIABLE  WITHIN  THE  PROGRAM. 

RR , I I OR  AA  NEW  VALUE  OF  THE  VARIABLE  AVAR  TO  BE 

SUPPLIED  IN  THE  APPROPRIATE  FIELD  DETERMINED 
BY  THE  VALUE  OF  ITYPE. 


RROLD,  HOLD  THE  PREVIOUS  VALUE  OF  THE  VARIABLE  AVAR  IN 

OR  AAOLD  THE  APPROPRIATE  FIELD  ACCORDING  TO  THE  ITYPE 

VALUE.  INTEGER  OR  ALPHANUMERIC  DATA  WILL  BE 
TESTED  EXACTLY,  REAL  DATA  TO  5 SIGNIFICANT 
DIGITS.  IF  THE  CURRENT  VALUE  IS  DIFFERENT, 
THE  PROGRAM  WILL  TERMINATE  WITH  AN  ERROR 
MESSAGE.  IF  ZERO  OR  BLANK  IS  SUPPLIED, NO 
CHECK  IS  PERFORMED. 


THESE  A. 2 CARDS  WILL  BE  PROCESSED  UNTIL  A BLANK  VALUE  FOR 
AVAR  IS  ENCOUNTERED.  NO  FURTHER  INPUT  IS  REQUIRED. 
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CARD  A. 3 


FORMAT  (3A4,  3F12.0) 


UNITL 

UNIT  OF  LENGTH  (4  CHARACTERS) 

UNITM 

UNIT  OF  FORCE  (MASS)  (4  CHARACTERS) 

UN  ITT 

UNIT  OF  TIME  (4  CHARACTERS). 

NOTE  : UNITL,  UNITM  AND  UN  ITT  SHOULD  CORRESPOND  TO  THE  USER'S 

INPUTS.  THROUGHOUT  THIS  DESCRIPTION,  INCHES,  POUNDS  AND  SECONDS 
(IN, LBS, SEC)  ARE  USED  AS  SAMPLE  UNITS. 

GR AVTY (I), 1=1, 3 THE  X,  Y AND  2 COMPONENTS 


OF  GRAVITY  (IN/SEC**2). 

CARD  A. 4 

FORMAT  (214,  4F8.0) 

NDINT 

NUMbER  OF  ITERATIONS  FOR  FINAL  CONVERGENCE 
TEST  OF  THE  INTEGRATOR  SUBROUTINE  DINT 
(MINIMUM  VALUE  = 2,  SUGGESTED  VALUE  =4). 

NSTEPS 

NUMbER  OF  INTEGRATION  STEPS  (OR  OUTPUT 
TIME  POINTS)  FOR  THE  INTEGRATOR  ROUTINE. 
MAY  BE  ZERO  TO  OBTAIN  INITIAL  CONDITIONS. 

DT 

MAIN  PROGRAM  TIME  INTERVAL  FOR  INTEGRATOR 
ROUTINE  OUTPUT  (SEC).  TOTAL  TIME  OF  RUN 
WILL  BE  NSTEPS*DT  SECONDS  WITH  MAIN  PROGRAM 
TAPE  1,  PRINTER  PLOT  AND  OPTIONAL  OUTPUT 
PRODUCED  EVERY  DT  SECONDS. 

HO 

INITIAL  INTEGRATOR  STEP  SIZE  (SEC). 

HMAX 

MAXIMUM  INTEGRATOR  STEP  SIZE  (SEC).  FOR  BEST 
EFFICIENCY  DT  SHOULD  BE  AN  INTEGRAL  MULTIPLE 
OF  HMAX  AND  HMAX  A POWER  OF  TWO  MULTIPLE 
OF  HO.  (SUGGESTED  VALUE  = O.OOl  SEC.) 

HMIN 

MINIMUM  INTEGRATOR  STEP  SIZE  (SEC).  IF  A 
FIXED  STEP  SIZE  IS  DESIRED,  SET  HMIN  GREATER 
THAN  HMAX,  AND  STEP  SIZE  WILL  DOUBLE  FROM  HO 
UNTIL  HMAX  IS  ACHIEVED. 
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CARO  A. 5 


FORMAT  (4012) 


NPRT (I), 1=1, 40  AN  ARRAY  OF  INDICATORS  THAT  CONTROL  VARIOUS 

OPTIONAL  DIAGNOSTIC  OUTPUT  FOR  THE  PROGRAM. 

A VALUE  OF  ZERO  OR  BLANK  INDICATES  NO  OUTPUT 
FOR  THAT  PARTICULAR  ITEM.  IN  GENERAL,  A VALUE 
OF  1 MEANS  THAT  THE  OUTPUT  WILL  BE  PRODUCED 
EVERY  TIME  A PARTICULAR  SUBROUTINE  IS  EXEC- 
UTED. HOWEVER,  FOR  ELEMENTS  1-6  THE  VALUE 
INDICATES  THE  PRINT  FREQUENCY,  E.G.,  A VALUE 
OF  5 WILL  PRODUCE  OUTPUT  EVERY  5TH  EXECUTION 
OF  THE  SUBROUTINE.  OUTPUT  PRODUCED  BY  ELE- 
MENTS 7-26  IS  INTENDED  FOR  DIAGNOSTIC  OR 
"CHECK  OUT"  PURPOSES  AND  IS  NOT  COMPLETELY 
LABELED.  THE  USER  SHOULD  CONSULT  THE  LISTING 
OF  THE  SUBROUTINE  FOR  A DESCRIPTION  OF  THE 
VARIABLES  THAT  ARE  PRINTED. 


THE  NPRT  ARRAY 


ELEMENT 

NO.  SUBROUTINE 


1 

MAIN 

2 

MAIN 

3 

MAIN 

4 

NOT  USED 

5 

PRIPLT 

6 

PRIPLT 

7 

BINPUT 

8* 

DAUX 

9 

DAUX 

10 

IMPULS 

11 

SETUP1 

12 

VISPR 

13 

PRIPLT 

14 

WINDY 

15 

BELTG 

16 

HBELT 

17 

EDEPTH 

18 

NOT  USED 

19 

NOT  USED 

20 

CHAIN 

21 

AIRBAG 

22 

AIRBG1 

23 

AIRBG3 

24 

UPDATE 

25 

DINT 

26 

DINT 

OUTPUT 

PRODUCED 

TAPE  1 OUTPUT 
ELTIME  OUTPUT 
SUBROUTINE  PRINT  OUTPUT 

Y-Z  VIEW  PRINTER  PLOT 
X-Z  VIEW  PRINTER  PLOT 
HA,  HB 

I JK,RHS  »C  ARRAYS 
SUBROUTINE  PRINT  OUTPUT 
DIAGNOSTIC  OUTPUT 
U2,V1  ARRAYS 
DIAGNOSTIC  OUTPUT 
CJOINT  ARRAY 
WIND  FORCES 
DIAGNOSTIC  OUTPUT 
HARNESS-BELT  FORCES 
DIAGNOSTIC  OUTPUT 


XCOMP ,X VCOMP , S EGLP , SEGLV 
DIAGNOSTIC  OUTPUT 
DIAGNOSTIC  OUTPUT 
DIAGNOSTIC  OUTPUT 
ROLL-SLIDE  TEST  OUTPUT 
CONVERGENCE  TEST  DATA 
SUBROUTINE  OUTPUT  EVERY  STEP 


* A VALUE  OF  NPRT ( 8 ) = 2 WILL  PRINT  ARRAYS  BEFORE  AND 
AFTER  THE  FIRST  CALL  TO  SUBROUTINE  FSMSOL  ONLY. 
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B 


SUBROUTINE  BINPUT 


CARD  B.l 

FORMAT  (216,  8X,  5A4) 

NSEG 

THE  NUMBER  OF  SEGMENTS  (MAXIMUM  = 20). 

NOTE:  THE  VEHICLE  AND  GROUND  HILL  BE  ASSIGNED 
SEGMENT  NUMBERS  NSEG+1  AND  NSEG+2. 

N JNT 

THE  NUMBER  OF  JOINTS  (MAXIMUM  = 21). 
NOTE:  NORMALLY  NJNT  = NSEG-1,  BUT  JOINT 
NUMBERS  NSEG  AND  NSEG+1  MAY  BE  USED  TO 
CONNECT  THE  VEHICLE  AND  THE  GROUNU  TO 
LOWER  NUMBERED  SEGMENTS. 

BDYTTL(I), 1=1,3 

DESCRIPTION  OF  THE  CRASH  VICTIM 
(20  CHARACTERS). 

CARDS  B.2.A  - B.2.I 
(NSEG  CARDS) 

FORMAT  ( A4,  IX,  Al,  I0F6.0) 

EACH  CARD  ( I ) FOR 

1=1,  NSEG  HILL  CONTAIN  INPUT  DATA  FOR  THE  ITH 

SEGMENT.  THE  SEGMENT  IDENTIFYING  NUMBERS  (I)  WILL  BE  REFERRED  TO 
ON  LATER  INPUT  CARDS. 


SEG(I) 

AN  ABBREVIATION  OF  THE  NOMENCLATURE 
OF  THE  ITH  SEGMENT  (A  CHARACTERS). 

CGS(I) 

THE  PLOT  SYMBOL  OF  THE  SEGMENT  C.G. 
( 1 CHARACTER) . 

W(  1 1 

THE  WEIGHT  OF  THE  SEGMENT  (LBS). 

PHI ( J, I ) » J-l » 3 

THE  PRINCIPAL  MOMENTS  OF  INERTIA  OF  THE 

SEGMENT  ABOUT  THE  X,  Y,  AND  Z 

AXES  OF  THE  SEGMENT  (LBS-SEC**2-IN ) . 

THERE  ARE  NO  RESTRICTIONS  ON  THE  VALUES  OF 
W(I)  OR  PHI ( J , I ) , THEY  MAY  BE  NEGATIVE  OR 
ZERO.  IF  ANY  COMPONENT  IS  ZERO,  IT  IS 
ASSUMED  THAT  THE  SYSTEM  IS  SUITABLY  CON- 
STRAINED SO  THAT  THE  SYSTEM  MATRIX  IS  NON- 
SINGULAR. 

BD( J,I ), J=I,3 

THE  X,  Y,  AND  Z SEMIAXES  OF  THE 
SEGMENT  CONTACT  ELLIPSOID  (IN). 

BD ( J » I )f J=4,6 

THE  LOCATION  OF  THE  CENTER  OF  THE  SEGMENT 
CONTACT  ELLIPSOID,  WITH  RESPECT  TO  THE 
CENTER  OF  GRAVITY  OF  THE  SEGMENT,  IN  THE 
LOCAL  BODY  SEGMENT  REFERENCE ( IN ) . THESE 
PRIMARY  CONTACT  ELLIPSOIDS  ARE  GIVEN  THE 
SAME  INDENTIFYING  NUMBER  AS  THE  SEGMENT. 
THEY  MAY  BE  REDEFINEO  WITH  AN  ARBITRARY 
ORIENTATION  ON  CARDS  D.5. 
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CARDS  B.3.A  - B.3.J 

(2*NJNT  CARDS  - 2 

EACH  CARD  (J)  FOR 
JOINT.  THE  JOINT 
LATER  INPUT  CARDS 

JOINT ( J ) 

JS(  J) 

JNT ( J) 


IPIN( J ) 


SR ( I ,2  * J-l ) »I=1»3 
SR ( I »2  * J ) » 1 = 1 » 3 


FORMAT  (A4,  IX,  Al,  214,  6F6.0/  14X,  6F6.0) 
CARDS  FOR  EACH  JOINT) 

J = 1,  N JNT  WILL  CONTAIN  INPUT  DATA  FOR  THE  JTH 
IDENTIFYING  NUMBERS  (J)  WILL  BE  REFERRED  TO  ON 


AN  ABBREVIATION  OF  THE  NOMENCLATURE 
OF  THE  JTH  JOINT  (4  CHARACTERS). 


PLOT  SYMBOL  OF  THE  JOINT  LOCATION  (1  CHARACTER). 


MAGNITUDE  INDICATES  THE  NUMBER  OF  THE  SEGMENT 
THAT  IS  CONNECTED  TO  SEGMENT  J+l  BY  JOINT  J. 
IF  NEGATIVE,  JOINT  J IS  ASSOCIATED  WITH  A 
FLEXIBLE  ELEMENT.  IF  ZERO,  SEGMENT  J+I  IS 
THE  REFERENCE  SEGMENT  OF  ANOTHER  BODY. 

( | JNT ( J ) I < J + l). 


0 - THERE  ARE  TO  BE  NO  CONSTRAINTS  ON  JOINT  J. 

1 - JOINT  J IS  PINNED  (HINGE). 

2 - JOINT  J IS  NOT  PINNED  (BALL  AND  SOCKET). 

4 - JOINT  J IS  AN  EULER  JOINT. 

NON-ZERO  VALUES  FOR  IPIN  MAY  BE  SUPPLIED 
AS  POSITIVE  OR  NEGATIVE  TO  INDICATE  THAT  THE 
INITIAL  CONDITION  OF  THE  JOINT  IS  UNLOCKED 
(POSITIVE)  OR  UNLOCKED  (NEGATIVE). 

THE  INITIAL  STATE  OF  AN  EULER  JOINT  IS  SET  BY 
USE  OF  IPIN  AS  FOLLOWS 


IEULER  STATE 

8 FREE 

7 ALL  AXES  LOCKED 
6 SPIN  FREE,  OTHERS  LOCKED 

5 NUTATION  FREE,  OTHERS  LOCKED 

4 PRECESSION  FREE,  OTHERS  LOCKED 

3 SPIN  LOCKED,  OTHERS  FREE 

2 NUTATION  LOCKED,  OTHERS  FREE 

1 PRECESSION  LOCKED,  OTHERS  FREE 

ABOUT  Z 

ABOUT  RESULTANT  X 
ABOUT  RESULTANT  Z ) 

IF  IPIN  IS  LESS  THAN  -3  PROGRAM  WILL  SET  IEULER 
AS  ABOVE  AND  THEN  SET  IPIN  = -4. 


IPIN 
4 

- 4 

- 5 

- 6 

- 7 

- B 

- 9 
-10 

( PRECESSION 

NUTATION 

SPIN 


COORDINATES  OF  LOCATION  OF  JOINT  J (IN.)  IN 
THE  LOCAL  REFERENCE  SYSTEM  OF  SEGMENT  JNT(J). 


COORDINATES  OF  LOCATION  OF  JOINT  J (IN.)  IN 
THE  LOCAL  REFERENCE  SYSTEM  OF  SEGMENT  J+l. 
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FOLLOWING  DATA  IS  ON  2ND  CARD  FOR  EACH  JOINT. 


YPRKI,  J),I=1,3 


THE  YAW y PITCH  AND  ROLL  ANGLES  (DEGREES) 

SPECIFYING  THE  PRINCIPAL  AXES  OF  JUINT  J IN 

THE  LOCAL  REFERENCE  SYSTEM  OF  SEGMENT  JNT(J) 

YAW  ABOUT  Z AXIS 

PITCH  ABOUT  RESULTANT  Y AXIS 

ROLL  ABOUT  RESULTANT  X AXIS 


YPR2(I,J),I=1,3 


THE  YAW,  PITCH  AND  ROLL  ANGLES  (DEGREES) 
SPECIFYING  THE  PRINCIPAL  AXES  OF  JOINT  J IN 
THE  LOCAL  REFERENCE  SYSTEM  OF  SEGMENT  J + l. 
THE  Z AXIS  IS  THE  REFERENCE  AXIS  TO  DEFINE 
FLEXURE.  THE  Y AXIS  IS  USED  AS  THE  PIN  AXIS 
EXCEPT  FOR  THE  SPECIAL  EULER  JOINTS.  THE  XY 
PLANE  IS  USED  FOR  GLOB ALGRAPHIC  JOINTS  WITH 
X AS  THE  REFERENCE  AXIS. 
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CARDS  B.4.A  - B.4.J  FORMAT  (2  (4F6.0,  F12.0)) 

(NJNI  SETS  OF  CARDS,  ONE  FOR  EACH  JOINT  J.  IF  |IPIN(J)|  # A, 
EACH  SET  READS  VALUES  FOR  3*J-2  AND  3*J-1  ON  ONE  CARD  ONLY. 

IF  | IP  IN ( J ) | = A , JOINT  J IS  AN  EULER  JOINT  AND  A SECOND  CARD 
IS  NECESSARY  TO  READ  VALUES  FOR  3*J  ) 


SPRING ( I ,3* J— 2 ) , THE  FLEXURAL  SPRING  CHARACTERISTICS  FOR 

1=1,5  JOINT  J.  IF  J IS  AN  EULER  JOINT,  THE  SPRING 

CHARACTERISTICS  ABOUT  THE  PRECESSION  AXIS. 
IF  JOINTF(J)  # 0 (ON  CARD  F.5.A),  THESE 
VALUES  ARE  NOT  USED  AND  SHOULD  BE  ZERO. 


SPRING ( I , 3* J— 1 ) , 
1=1,5 


THE  TORSIONAL  SPRING  CHARACTERISTICS  FOR 
JOINT  J.  IF  J IS  AN  EULER  JOINT,  THE  SPRING 
CHARACTERISTICS  ABOUT  THE  NUTATION  AXIS. 


SPRING(I,3*J) , 
1 = 1,5 


SECOND  CARD  OF  EACH  SET  IS  REQUIRED 
ONLY  IF  J IS  AN  EULER  JOINT,  THE  SPRING 
CHARACTERISTICS  ABOUT  THE  SPIN  AXIS. 


1=1  LINEAR  SPRING  COEFFICIENT 

( IN-LBS/DEG). 


1=2  QUADRATIC  SPRING  COEFFICIENT 

(IN— LBS/DEG**2). 

1=3  CUBIC  SPRING  COEFFICIENT 

( IN— LBS/DEG**3) . 

1=4  ENERGY  DISSIPATION  COEFFICIENT 

(DIMENSIONLESS) . 

A VALUE  OF  1.  SPECIFIES  NO  LOSS 
A VALUE  OF  0.  SPECIFIES  MAXIMUM  LOSS 


1=5  JOINT  STOP  LOCATION  WITH  RESPECT  TO 

THE  CENTER  OF  SYMMETRY  (DEG). 

FOR  A VALUE  OF  ZERO  THE  ROUTINE  WILL  USE  ONLY 
THE  LINEAR  SPRING  COEFFICIENT  AND  WILL  APPLY 
THE  ENERGY  DISSIPATION  FACTOR 
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CARDS  B.5.A  - 6.5.J  FORMAT!  5F6.0,  18X,  2F6.0) 

(NJNT  SETS  OF  CARDS,  ONE  FOR  EACH  JOINT  J.  IF  |IPIN(J)|  # 4, 
VALUES  FOR  3*J-2  ARE  ON  ONE  CARD  ONLY.  IF  |IPIN(J)|  = 4, 

J IS  AN  EULER  JOINT  AND  VALUES  FOR  3*J-1  AND  3*J  ARE  REQUIRED 
ON  A SECOND  AND  THIRD  CARD  OF  EACH  SET.) 


VISC(I ,3*J-2>, 
1 = 1,7 


THE  VISCOUS  CHARACTERISTICS  FOR  JOINT  J. 
IF  J IS  AN  EULER  JOINT,  THE  VISCOUS  CHAR- 
ACTERISTICS ABOUT  THE  PRECESSION  AXIS. 


VISC(I, 3*J-1),  THE  SECOND  CARD  OF  EACH  SET  IS  REQUIRED 

1=1,7  ONLY  IF  J IS  AN  EULER  JOINT,  THE  VISCOUS 

CHARACTERISTICS  ABOUT  THE  NUTATION  AXIS. 


VISCd  ,3*J) 
1=1,7 


THE  THIRD  CARD  OF  EACH  SET  IS  REQUIRED 
ONLY  IF  J IS  AN  EULER  JOINT,  THE  VISCOUS 
CHARACTERISTICS  ABOUT  THE  SPIN  AXIS. 


1=1  VISCOUS  COEFFICIENT  ( IN-LB— SEC /DEG ) • 


1=2  COULOMB  FRICTION  COEFFICIENT  (IN-LB). 

1=3  RELATIVE  ANGULAR  VELOCITY  OF  JOINT 

AT  WHICH  FULL  COULOMB  FRICTION  IS 
APPLIED  (DEG/SEC).  MUST  BE  GREATER  THAN  0. 


1=4  TlS  THE  MAXIMUM  TORQUE  (IN-LBS)  ALLOWED  FOR  A 

LOCKED  JOINT  (OR  EULER  AXIS).  IF  EXCEEDED, THE 
JOINT  WILL  UNLOCK.  IF  T1  = 0,  THE  TEST  WILL 
NOT  BE  PERFORMED. 


1=5  T2 i THE  MINIMUM  TORQUE  (IN-LBS) 

ALLOWED  FOR  JOINT  J TO  REMAIN  UNLOCKED. 

IF  T2  = 0,  THE  TEST  WILL  NOT  BE  PERFORMED. 

1=6  T3:  THE  MINIMUM  ANGULAR  VELOCITY  (RAD/SEC) 

NECESSARY  FOR  JOINT  J TO  REMAIN  UNLOCKED. 

IF  T3  = 0,  THE  TEST  WILL  NOT  BE  PERFORMED. 

1=7  E = (l+U)/2  WHERE  U IS  THE  CLASSICAL 

COEFFICIENT  OF  RESTITUTION  TO  BE  USED  FOR  THE 
IMPULSE  OPTION  IF  THE  JOINT  HITS  THE  JOINT 
STOP  ( 0<E<1  OR  -KIK+l  ) • A VALUE  OF  E = 0 
MEANS  THAT  THE  IMPULSE  OPTION  WILL  NOT  BE 
EXERCISED  FOR  THIS  JOINT. 
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CARDS  B.6.A  - B.6.I 
( NSEG  CARDS) 


FORMAT  (12F6.0) 


SGTEST (1,1,1) 


MAGNITUDE  TbST  FOR  THE  ANGULAR  VELOCITY 
OF  SEGMENT  NO.  I (RAD/SEC). 


SGTE  ST ( 2 , 1 » I ) 


ABSOLUTE  ERROR  TEST  FOR  THE  ANGULAR 
VELOCITY  OF  SEGMENT  NO.  I (RAD/SEC) 


SGTEST (3*1,1) 


RELATIVE  ERROR  TEST  FOR  THE  ANGULAR 
VELOCITY  OF  SEGMENT  NO.  I (DIMENSIONLESS) 


SGTEST (1,2,1) 


SAME  AS  ABOVE,  BUT  FOR  THE  LINEAR 
VELOCITY  OF  SEGMENT  NO.  I (IN/SEC) 


(2,2,1) 

(3,2,1) 


SGTE  ST (1,3,1) 


SAME  AS  ABOVE,  BUT  FOR  THE  ANGULAR 
ACCELERATION  OF  SEGMENT  NO.  1 (RAD/SEC**2) 


(2.3.1) 

(3.3.1) 


SGTEST (1,4,1) 


SAME  AS  ABOVE  BUT  FOR  THE  LINEAR 
ACCELERATION  OF  SEGMENT  NO.  1 (IN/SEC**2) 


(2, A, I) 
(3,4,1  ) 


THESE  CONVERGENCE  TESTS  ARE  PERFORMED  IN  SUBROUTINE  DINT  ON  THE 
RESULTANT  OF  THE  DERIVATIVE  VECTORS.  THE  LINEAR  VELOCITIES  AND 
ACCELERATIONS  ARE  COMPUTED  ONLY  FUR  REFERENCE  SEGMENTS  (I.E.  SEGMENT 
NO.  1 AND  THOSE  SEGMENTS  1 WHERE  JNT(I-l)  = 0),  THEREFORE  ANY  TEST 
NUMBERS  SUPPLIED  FOR  LINEAR  VELOCITIES  AND  ACCELERATIONS  OF  OTHER 
SEGMENTS  WILL  BE  IGNORED.  THE  TESTS  FOR  CONVERGENCE  ARE  PERFORMED 
IN  THE  FOLLOWING  ORDER  : 

1)  IF  THE  MAGNITUDE  TEST  IS  ZERO,  NO  TESTING  IS  DONE  FOR  THAT 
VARIABLE . 

2)  IF  THE  MAGNITUDE  OF  THE  RESULTANT  VECTOR  IS  LESS  THAN  THE 
MAGNITUDE  TEST, THE  RUUT INE  HAS  PASSED  THE  CONVERGENCE  TEST 
FOR  THAT  VARIABLE. 

3)  IF  THE  ABSOLUTE  ERROR  TEST  IS  GREATER  THAN  ZERO,  AND  THE 
MAGNITUDE  OF  THE  ABSOLUTE  ERROR  (DIFFERENCE  BETWEEN  THE  PREDICTED 
AND  COMPUTED  VECTOR)  IS  LESS  THAN  THE  ABSOLUTE  ERROR  TEST,  THE 
ROUTINE  HAS  PASSED  THE  CONVERGENCE  TEST  FOR  THAT  VARIABLE. 

4)  IF  THE  RELATIVE  ERROR  OF  THE  MAGNITUDE  OF  THE  ABSOLUTE  ERROR 
COMPARED  TO  THE  MAGNITUDE  OF  THE  COMPUTED  VECTOR  IS  GREATER 
THAN  THE  RELATIVE  ERROR  TEST,  THE  CONVERGENCE  TEST  HAS  FAILED. 
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IF  NFLX  # 0,  CARDS  B.7  ARE  REQUIRED.  EACH  FLEXIBLE  ELEMENT  AS 
DEFINED  ON  CARDS  B .3  CONTAINS  AT  LEAST  THREE  CONNECTED  SEGMENTS 
CONSISTING  OF  A REFERENCE  SEGMENT,  ONE  OR  MORE  INTERIOR  SEGMENTS 
AND  A TERMINATING  SEGMENT.  EACH  JOINT  IN  THE  ELEMENT  SHOULD  HAVE 
A NEGATIVE  VALUE  FOR  JNT , AND  THE  NUMBER  OF  INTERIOR  SEGMENTS 
WILL  BE  ONE  LESS  THAN  THt  NUMBER  OF  NEGATIVE  VALUES  OF  JNT  FOR 
EACH  ELEMENT.  NFLX  IS  THE  TOTAL  NUMBER  OF  INTERIOR  SEGMENTS  OF 
ALL  FLEXIBLE  ELEMENTS. 

CARD  13.  7.  A 

NFX 


FORMAT  ( 1814 ) 

THE  NUMBER  OF  INTERIOR  SEGMENTS  FOR 
WHICH  HF  ARRAYS  ARE  TO  BE  SUPPLIED. 


KNT(K) ,K=1,NFX  THE  INTERIOR  SEGMENT  IDENTIFICATION  NUMBERS 

IN  THE  ORDER  OF  THE  HF  ARRAYS  TO  BE  SUPPLIED. 

IF  THE  VALUES  OF  NFX  AND  KNT  ARE  NOT  CONSISTENT 
WITH  THE  NEGATIVE  VALUES  OF  JNT  ON  CARDS 
B.3  THE  PROGRAM  WILL  TERMINATE  WITH  AN 
APPROPRIATE  ERROR  MESSAGE. 

CARDS  B.7.B  - B.7.N  FORMAT  (12F6.0  ) 

(4*NFX  CARDS,  4 CARDS  FOR  EACH  SEGMENT  IN  THE  ORDER  AS  THEY 
ARE  DEFINED  IN  THE  KNT  VECTOR.) 


(HF( I,J,K) , J=l,12)  THE  COEFFICIENTS  OF  THE  QUADRATIC  FORM 
,1=1,4  FUNCTION  USED  TO  DEFINE  THE  ORIENTATION 

UF  INTERIOR  SEGMENT  KNT(K)  WITH  RESPECT  TO 
REFERENCE  SEGMENT  OF  THE  ELEMENT. 


FORM  THE  COLUMN  VECTOR  V WITH  FOUR  COMPONENTS  Y,P,R  AND  1, 

WHERE  Y , P , R ARE  THE  YAW,  PITCH  AND  ROLL  OF  THE  TERMINATING 
SEGMENT  RELATIVE  TO  THE  REFERENCE  SEGMENT.  LET  H BE  A SYMMETRIC 
4X4  MATRIX  SUCH  THAT  F(V)  = 1/2  V.HV  REPRESENTS  A QUADRATIC 
SCALAR  FUNCTION  OF  THE  VARIABLES  Y,P  AND  R IN  RADIANS.  THUS 


YAW 

OF 

SEGMENT 

KNT(K)  = 

1/2 

V.HF { I , J ,K  ) V 

PITCH 

OF 

SEGMENT 

KNT(K)  = 

1/2 

V.HFCI, J+4,K)V 

ROLL 

OF 

SEGMENT 

KNT(K)  = 

1/2 

V.HF (I, J+8,K)V 
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C.  SUBROUTINE  VINPUT 

CARD  C.l 

VPSTTLd  > » I = 1 

CARD  C.2 

ANGLE( I) ,1=1, 


VIPS 

VTIME 

X0(I),I=l,3 

NATAB 


FORMAT  (20A4) 

20  DESCRIPTION  OF  THE  CRASH  VEHICLE  DECELERATION 
(80  CHARACTERS). 


FORMAT  (8F6.0,  16,  2F6.0) 

FOR  THE  HALF  SINE-HAVE  DECELERATION 
(NATAB  = 0)  OR  FOR  THE  UNIDIRECTIONAL 
DECELERATION  TABULAR  INPUT  (NATAB  > 0), 

ANGLE ( I ) AND  ANGLE ( 2 ) REPRESENT  THE 
AZIMUTH  AND  ELEVATION  (OBLIQUE  ANGLES) 

OF  THE  DIRECTION  OF  THE  DECELERATION 
IMPULSE  (DEG).  ANGLE ( 3 ) IS  NOT  USED 
AND  THE  INITIAL  YAW,  PITCH  AND  ROLL 
OF  THE  VEHICLE  ARE  ASSUMED  TO  BE  ZERO. 

FOR  THE  OMNIDIRECTIONAL  TABULAR  INPUT 
(NATAB  < 0).  THEY  REPRESENT  THE  INITIAL 
YAW,  PITCH  AND  ROLL  OF  THE  VEHICLE  (DEG). 

THE  INITIAL  VELOCITY  OF  THE  CRASH  VEHICLE. 
(IN/SEC  - UNITS  AS  SPECIFIED  ON  CARD  A.3) 

A NEGATIVE  VALUE  MAY  BE  SUPPLIED  FOR  NATAB=0 
TO  INDICATE  THAT  THE  VEHICLE  WILL  ACCELERATE 
FROM  A VELOCITY  OF  ZERO  TO  I VIPS  I. 

THE  TIME  DURATION  OF  THE  DECELERATION 
IMPULSE  (SEC).  REQUIRED  ONLY  IF  NATAB  = 0. 

A VALUE  OF  ZERO  IS  NOT  PERMITTED  IF  NATAB=0 • 

THE  INITIAL  X,  Y,  AND  Z COORDINATES 
OF  THE  VEHICLE  REFERENCE  ORIGIN  IN 
INERTIAL  REFERENCE  (IN). 

INTEGER  NUMBER  OF  TIME  POINTS  FOR  WHICH 
VEHICLE  DECELERATION  DATA  IS  TO  BE  SUPPLIED. 
THE  ALGEBRAIC  SIGN  OF  NATAB  DETERMINES  THE 
TYPE  OF  VEHICLE  MOTION  AS  FOLLOWS: 

IF  NATAB  = 0,  THE  DIRECTION  IMPULSE  IS  AN 
ANALYTICAL  HALF-SINE  WAVE  FUNCTION  THAT 
DECELERATES  THE  VEHICLE  FROM  AN  INITIAL 
SPEED  OF  VMPH  TO  ZERO  IN  VTIME  SECONDS. 

IF  NATAB  > 0,  THE  VEHICLE  MOTION  IS 
UNIDIRECTIONAL  AND  ONLY  THE  RESULTANT  LINEAR 
DECELERATION  IS  INPUTTED  IN  TABULAR  FORM  ON 
CARDS  C.3.  (NATAB  SHOULD  BE  ODD  AND  MAXIMUM 
VALUE  IS  99.) 

IF  NATAB  < 0,  THE  VEHICLE  MOTION  IS  ALSO 
ROTATIONAL,  AND  THE  COMPONENTS  OF  BOTH 
LINEAR  AND  ANGULAR  ACCELERATION  ARE  INPUTTED 
IN  TABULAR  FORM  ON  CARDS  C.4.  (MINIMUM 
VALUE  OF  NATAB  IS  -100.) 
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ATO 


THE  BEGINNING  TIME  POINT  FOR  THE 
DECELERATION  TABLE  INPUT  (SEC). 


ADT  FIXED  TIME  INTERVAL  FOR  THE  DECELERATION 

TABLE  INPUT  (SEC). 


CAROS  C.3.A  - C.3.N  FORMAT  (12F6.0) 

THESE  CARDS  ARE  REQUIRED  ONLY  IF  NATAB  > 0. 

ATAB ( 1 » I ) ,1  = 1 fNATAB  THE  NATAB  VALUES  OF  DECELERATION 

(G»S)  FOR  THE  CRASH  VEHICLE 
FOR  FIXED  TIME  INTERVALS 

T ( I ) = ATO  + (I-1)*ADT  FOR  1=1, NATAB. 

SUPPLY  12  VALUES  PER  CARD,  USE  AS  MANY  CARDS 
AS  NECESSARY.  SINCE  A SIMPSON»S  INTEGRATION 
IS  USED  TO  COMPUTE  VELOCITY  AND  POSITION, 

THE  VALUE  OF  NATAB  MUST  BE  ODD.  THE  LAST 
VALUE,  ATAB(1, NATAB)  WILL  BE  USED  TO  INTEGRATE 
FOR  ANY  TIME  GREATER  THAN  T ( NATAB-1 ) • 


CARDS  C.4.A  - C.4.M  FORMAT  (10X,  6F10.0) 

MATAB  CARDS  ARE  REQUIRED  ONLY  IF  NATAB  < 0 (MATAB  = -NATAB) 

EACH  CARD  (I)  WILL  CONTAIN  THE  LINEAR  AND  ANGULAR  ACCELERATIONS 

FOR  TIME  TCI)  = ATO  + ( 1-1 )*ADT  FOR  I = 1, MATAB. 

AT AB ( J , 1 ) , J = L , 3 THE  VALUES  OF  THE  X,Y  AND  Z COMPONENTS  OF 

LINEAR  DECELERATION  (G»S)  FOR  TIME  POINT 
TCI).  THt  PROGRAM  WILL  INTEGRATE  FOR  VELOCITY 
AND  POSITION  BEYOND  THE  LAST  TIME  POINT 
USING  THE  LAST  VALUES  SUPPLIED. 

ATAB( J,I ), J=4,6  THE  VALUES  OF  THE  COMPONENTS  OF  ANGULAR 

ACCELERATION  (DEG/SEC**2)  FOR  TIME  POINT(I). 
THE  VALUES  FOR  THE  LAST  TIME  POINT  MUST  BE 
ZERO  WHICH  IS  ASSUMED  BY  PROGRAM  FOR 
INTEGRATING  BEYOND  THE  LAST  TIME  POINT. 
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D • SUBROUTINE 

SINPUT 

CARD  D • I 

FORMAT  ( 616 ) 

NPL 

THE  NUMBER  OF  PLANES  DESCRIBING 
A CONTACT  PANEL  OF  THE  VEHICLE 
(20  MAXIMUM). 

NBLT 

THE  NUMBER  OF  BELTS  USED  TO  RESTRAIN  THE 
CRASH  VICTIM  (8  MAXIMUM). 

NB  AG 

THE  NUMBER  OF  AIR  BAGS  USED  TO  RESTRAIN 
THE  CRASH  VICTIM  (5  MAXIMUM). 

NELP 

THE  NUMBER  OF  CONTACT  ELLIPSOIDS  TO  BE 
SUPPLIED  ON  CARDS  D.5. 

NU 

THE  NUMBER  OF  CONSTRAINTS  TO  BE  SUPPLIED 
ON  CARDS  D.b.  EACH  CONSTRAINT  TYPE  5 WILL  BE 
CONSIDERED  AS  TWO  CONSTRAINTS  REQUIRING  TWO 
SETS  OF  CARDS  (NOTE:  THE  PROGRAM  WILL  LATER 
INCREMENT  NQ  BY  I FOR  EACH  NF(1)  = 0 ON 
CARDS  F.I.B  AND  F.3.B  AND  THE  FINAL 
MAXIMUM  ON  NQ  IS  12). 

NSD 

THE  NUMBtR  OF  SPRING  DAMPERS  TO  BE  SUPPLIED 
ON  CARDS  D.B  (20  MAXIMUM). 
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IF  N PL  # 0,  NPL  SETS  OF  D.2  ARE  REQUIRED 


CARD  D.2. A 
J 

PLTTL( I,J),I=1 

CARDS  D.2.B  - D.2. 
PI ( I ) , 1=1 ,3 

P2 ( I ) » 1 = 1 » 3 

P3( I), 1=1, 3 

WHERE  PI,  P2,  AND 
SUCH  THAT  THE  EDGE 
EXTERNAL  SURFACE) 


FORMAT  (14,  4X , 5A4) 

THE  NUMBER  IDENTIFYING  THE  PLANE, 
MUST  BE  INPUTTEO  AS  SUCCESSIVE 
INTEGERS  1,  2,  3,...,  NPL. 

,5  A 20  CHARACTER  DESCRIPTION  OF  THE 
JTH  PANEL. 


D FORMAT  (3FI2.0) 

THE  X , Y AND  Z COORDINATES  OF  POINT  PI  IN 
VEHICLE  (OR  SEGMENT  TO  WHICH  PLANE  IS 
ATTACHED)  REFERENCE  (IN). 

THE  X, Y AND  Z COORDINATES  OF  POINT  P2  IN 
VEHICLE  (OR  SEGMENT  TO  WHICH  PLANE  IS 
ATTACHED)  REFERENCE  (IN). 

THE  X,Y  AND  Z COORDINATES  OF  POINT  P3  IN 
VEHICLE  (OR  SEGMENT  TO  WHICH  PLANE  IS 
ATTACHED)  REFERENCE  (IN). 

P3  ARE  3 OF  THE  CORNERS  OF  A BOUNDED  RECTANGULAR  PLANE 
PIP2  IS  90  DEGREES  CLOCKWISE  (AS  VIEWED  FROM  THE 
FROM  THE  EDGE  P1P3. 
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IF  NBLT  # 0,  NBLT  SETS  OF  D.3  ARE  REQUIRED. 


CARD  D.3. A 

FORMAT  (5A4) 

BLTTTL (I ,J) ,1=1.5 

A 20  CHARACTER  DESCRIPTION  OF  THE 
JTH  BELT. 

CARD  D.3.B 

FORMAT  (6F12.0) 

BELT(I ,J),I=1,3 

X,Y,  AND  Z COORDINATES*  IN  VEHICLE  (OR  SEGMENT 
TO  WHICH  BELT  IS  ANCHORED)  REFERENCE,  OF 
ANCHOR  POINT  A FOR  THE  JTH  BELT  (IN). 

BELT ( I , J ) ,1=4, 6 

X , Y*  AND  Z COORDINATES,  IN  VEHICLE  (OR  SEGMENT 
TO  WHICH  BELT  IS  ANCHORED)  REFERENCE,  OF 
ANCHOR  POINT  B FOR  THE  JTH  BELT  (IN). 

NOTE:  THE  PROGRAM  MUST 

PASS  A PLANE  THROUGH  THE  THREE  POINTS,  ANCHOR 

POINT  A,  ANCHOR  POINT  B,  AND  A FIXED  POINT  ON  THE  CONTACTED  BODY  SEGMENT 
IF  ANCHOR  POINTS  A AND  B COINCIDE , THEY  MUST  BE  SEPARATED  SLIGHTLY  FOR 
INPUT  SUCH  THAT  THE  DESIRED  BELT  PLANE  WILL  BE  DEFINED. 


CARD  D.3.C 

FORMAT  (5F12.0) 

BELT (I ,J),I=7,9 

X,  Y,  AND  Z COORDINATES,  IN  LOCAL  BODY 
SEGMENT  REFERENCE  (BUT  WITH  RESPECT  TO 
ELLIPSOID  CENTER,  NOT  C.G.),  OF  THE 
FIXED  CONTACT  POINT  ON  THE  BODY 
SEGMENT  FOR  THE  JTH  BELT  (IN). 

BELT(10, J) 

CURRENTLY  NOT  USED  BY  THE  PROGRAM. 

BELT (11, J) 

BELT  SLACK  (IN).  THE  SLACK,  WHEN  ADDED  TO 
THE  INITIAL  GEOMETRIC  LENGTH,  RESULTS  IN 
THE  INITIAL  BELT  LENGTH.  IF  DESIRED,  THE 
INITIAL  BELT  LENGTH  MAY  BE  INPUTTED  AS  A 
NEGATIVE  NUMBER  AND  THE  PROGRAM  WILL 
COMPUTE  THE  SLACK. 
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IF  NBAG  # 0,  NBAG  SETS  OF  D.4  ARE  REQUIRED  BY 
SUBROUTINE  AIRBGI » 


CARD  D.4. A 

FORMAT  (5A4,  14) 

BAGTTL  ( IfJ)  tl=rlf5 

A 20  CHARACTER  DESCRIPTION  OF  THE 
JTH  AIR  BAG. 

NP ANEL ( J ) 

NUMBtR  OF  VEHICLE  CONTACT  PANELS 
THAT  ARE  ALLOWED  TO  INTERACT  WITH 
THE  JTH  AIR  BAG  (MAXIMUM  =4). 

CARD  D.4.B 

FORMAT! 6F 12 .0 ) 

AB  ( 1 1 J ) t Ist  1 1 3 

THE  X,  Y AND  Z SEMIAXES  OF  THE  JTH  AIR  BAG 
WHtN  FULLY  INFLATED  AND  UNDEFURMEO  (IN). 

BFA ( ItJ) 1 1 = 1 1 3 

THE  X , Y AND  Z COORDINATES  OF  THE  CENTER  OF 
THE  AIR  BAG  CONTACT  ELLIPSOID  WITH  RESPECT 
TO  THE  AIR  BAG  CENTER  OF  GRAVITY  (IN). 

CARD  D.4.C 

FORMAT  (6F12.0) 

YBtPBtRB 

THE  INITIAL  ORIENTATION  (YAW,  PITCH, 
AND  ROLL)  OF  THE  JTH  AIR  BAG  IN  THE 
VEHICLE  REFERENCE  (DEG). 

ZDEP(ItJ), 1-1,3 

THE  X,  Y,  AND  Z COORDINATES  OF  THE 
DEPLOYMENT  POINT  OF  THE  JTH  AIR 
BAG  IN  THE  LOCAL  REFERENCE  OF  THE 
1ST  PANEL  UN  CARD  D.4.G  (IN). 

CARD  D.4.D 

FORMAT  (6F12.0) 

XBM ( J ) 

WEIGHT  OF  AIR  BAG  MEMBRANE  AND  CONTENTS  (LBS) 

CYTD(J) 

GAS  SUPPLY  ACTUATOR  FIRING  TIME  AFTER 
THE  START  OF  VEHICLE  DECELERATION  (SEC). 

C YP A ( J ) 

ATMOSPHERIC  PRESSURE  (PSIA). 

C YSP ( J ) 

INITIAL  GAS  SUPPLY  PRESSURE  (PSIG). 

CYTO ( J ) 

INITIAL  GAS  SUPPLY  TEMPERATURE  (DEG  R). 

CYVO ( J ) 

GAS  SUPPLY  RESERVOIR  VOLUME  (IN**3). 

46 


CARD  D.4.E 

FORMAT  (6F12.0) 

CYCO(J) 

SONIC  THROAT  DISCHARGE  COEFFICIENT 
(DIMENSIONLESS) . 

CYK(J) 

RATIO  OF  SPECIFIC  HEATS  OF  SUPPLY 
GAS  (DIMENSIONLESS). 

CYR ( J ) 

SPECIFIC  GAS  CONSTANT  (IN/DEG  R) . 

CYAT(J) 

SONIC  THROAT  AREA  ( IN**2  ) . 

C YPV ( J ) 

VENT  PRESSURE  OF  THE  EXHAUST 
ORIFICE  (PSIG). 

CYCDO ( J ) 

EXHAUST  ORIFICE  DISCHARGE 
COEFFICIENT  (DIMENSIONLESS). 

CARD  D.4.F 

FORMAT  (5F12.0) 

CYAO(J) 

EXHAUST  ORIFICE  AREA  (IN**2). 

SPRK ( J ) 

SPRING  CONSTANT  OF  A LINEAR  SPRING 
USED  TO  SIMULATE  ATTACHMENT  OF  THE 
BAG  AT  THE  DEPLOYMENT  POINT  IN  THE 
VEHICLE  (LB/IN). 

VSCS(J) 

COEFFICIENT  OF  SLIDING  FRICTION  OF 
THE  AIR  BAG  (DIMENSIONLESS) 

CK  ( J ) 

PARAMETER  USED  TO  STABILIZE  AIR 
BAG  NUMERICAL  INTEGRATION  (SEC**-1). 
SUGGESTED  VALUE  = 250. 

CMASS ( J ) 

MULTIPLIER  TO  INCREASE  OR  DECREASE 
THE  MASS  OF  THE  AIR  BAG  TO  ARTIFICIALLY 
DAMPEN  THE  INTEGRATED  AIR  BAG  MOTION. 
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NPANEL(J)  SETS  OF  THE  FOLLOWING  TWO  CARDS  ARE  REQUIRED  TO  DEFINE  THE 
ELLIPSOIDS  USED  TO  APPROXIMATE  THE  CONTACT  PANELS  FOR  THE  JTH  AIR  BAG. 
THE  FIRST  PANEL  IS  THE  REACTION  PANEL. 


CARD  D.4.G 

FORMAT  (6F12.0) 

B(I.KfJ) ,1=1,3 

X,  Y,  AND  Z SEMIAXES  FOR  THE  KTH 
PANEL  FOR  THE  JTH  AIR  BAG  (IN). 

BFB( I,K,J) ,1=1,3 

THE  LOCATION  OF  THE  CENTER  OF  THE 
PANEL  ELLIPSOID  WITH  RESPECT  TO  ITS 
CENTER  OF  GRAVITY  (IN). 

CARD  D.4.H 

FORMAT  (6F12.0) 

ZR(I,K,J), 1=1*3 

X,  Y,  AND  Z COORDINATES  IN  VEHICLE 
REFERENCE  OF  THE  CENTER  OF  GRAVITY 
OF  THE  KTH  PANEL  OF  THE  JTH  AIR  BAG  (IN) 

YP,PP,RP 

THE  ORIENTATION,  YAW,  PITCH,  AND 
ROLL  OF  THE  KTH  PANEL  (DEG). 
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IF  NELP  # 0,  NELP  D.5  CARDS  ARE  REQUIRED  8Y  SUBROUTINE  SINPUT. 


NOTE:  NELP  IS  THE  NUMBER  OF  CONTACT  ELLIPSOIDS  TO  BE  SUPPLIED  HERE, 
NOT  THE  NUMBER  OF  CONTACT  ELLIPSOIDS  IN  THE  PROGRAM.  THE  FIRST  NSEG 
ELLIPSOIDS  WERE  SUPPLIED  ON  CARDS  B.2.A  - B.2.I  WITH  NO  ANGULAR 
ROTATIONS.  THEY  MAY  BE  REPLACED  HERE  IF  DESIRED. 

CARDS  D.6.A  - D.5.J  FORMAT  (16,  9F6.0) 

(NELP  CARDS) 


M 

CONTACT  ELLIPSOID  NUMBER.  MAX  = 24.  IF 
M < NSEG  + 1,  DATA  WILL  REPLACE  INPUT  SUPPLIED 
ON  CARDS  B.2.A  - B.2.I. 

PI ( I l ,1=1,3 

THE  X,  Y,  AND  Z SEMIAXES  OF  THE  CONTACT 
ELLIPSOID  (IN). 

P2(I)»I=1»3 

THE  X,  Y,  AND  Z COORDINATES  OF  THE 
ELLIPSOID  OFFSET  FROM  THE  SEGMENT  CENTER 
OF  GRAVITY. 

P3(I)»I=1,3  THE  YAW,  PITCH  AND  ROLL  (DEGREES)  UF  THE 

CONTACT  ELLIPSOID  FROM  THE  PRINCIPAL  AXIS 
OF  THE  SEGMENT. 
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IF  NQ  # 0,  NQ  D.6  CARDS  ARE  REQUIRED  BY  SUBROUTINE  SINPUT 


CARDS  D.6. A - D.6.J 
(NQ  CARDS) 

FORMAT  (316,  6F6.0) 

KQTYPEIJ) 

TYPE  NO.  OF  THE  JTH  CONSTRAINT 
is  POINT  SPECIFIED  BY  RK1  ON  SEGMENT  KQ1 
WILL  BE  CONSTRAINED  TO  BE  THE  SAME  AS 
THE  POINT  SPECIFIED  BY  RK2  ON  SEGMENT 
KQ2. 

2:  POINT  SPECIFIED  BY  RK1  ON  SEGMENT  KQ1 
WILL  bE  CONSTRAINED  TO  REMAIN  AT  AN 
EQUAL  DISTANCE  (D  > 0)  FROM  THE  POINT 
SPECIFIED  BY  RK2  ON  SEGMENT  KQ2 • 

5:  TENSION  ELEMENT  CONSTRAINT  CONNECTING 
POINT  RK1  ON  SEGMENT  KQ1  TO  POINT  RK2 
UN  SEGMENT  RK2  (REQUIRES  TWO  CARDS  WITH 
KQTYPE , KQ1  AND  KQ2  THE  SAME  ON  BOTH). 

KQ1(J) 

SEGMENT  IDENTIFICATION  NUMBER  OF  THE 
1ST  SPECIFIED  POINT. 

KQ2 ( J ) 

SEGMENT  IDENTIFICATION  NUMBER  OF  THE 
2ND  SPECIFIED  POINT. 

RKMI,  J)  ,1  = 1,3 

COORDINATES  OF  SPECIFIED  POINT  ON 
SEGMENT  KQ1  (IN).  IF  KQTYPE  = 5,  THE  SECOND 
CARD  WILL  CONTAIN  THE  EFFECTIVE  MASSES  MA, 
MB  AND  MAB  (LB ,SEC**2/IN ) IN  PLACE  OF  RKI. 

RK2( I,J) ,1=1,3 

COORDINATES  OF  SPECIFIED  POINT  ON 
SEGMENT  KQ2  (IN).  IF  KQTYPE  = 5,  THE  SECOND 
CARD  WILL  CONTAIN  THE  SPRING  CONSTANT  K 
(LB/IN),  THE  VISCOUS  DAMPING  CONSTANT  0 
(LB  SEC/IN)  AND  THE  REFERENCE  LENGTH  L (IN) 
IN  PLACE  OF  RK2. 
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CARD  D .7  IS  ALWAYS  REQUIRED.  SUPPLY  BLANK  CARD  FOR  NORMAL  3D  MOTION 


CARD  D.7 


FORMAT  (1814)  IF  NSEGS18,  USE  2 CARDS. 


NSYM(J) ,J=1,NSEG  CONTROLS  SYMMETRY  OPTION  OF  BODY  SEGMENTS 

AS  FOLLUWS  : 

NSYM(J)  = 0 : NORMAL  THREE  DIMENSIONAL  MOTION  FOR  BODY 

SEGMENT  J. 

NSYM(J)  = J : MOTION  OF  BODY  SEGMENT  J WILL  BE  RESTRICTED 

TO  THE  X-Z  PLANE  WITH  NO  LATERAL  MOTION, 
HENCE  IT  WILL  BE  TWO  DIMENSIONAL. 


NSYM(J)  = K : BODY  SEGMENTS  J AND  K ARE  TO  REMAIN  SYMMETRICAL 

WITH  NO  LATERAL  MOTION.  THE  MOTION  OF  EACH  WILL 
BE  REPLACED  WITH  THEIR  AVERAGE  ANO  RESTRICTED 
TO  THE  LUCAL  X-Z  PLANE.  NSYM(K)  MUST  EQUAL  J. 


NSYM(J)  = -K  : BODY  SEGMENTS  J AND  K ARE  TO  REMAIN  MIRROR 

SYMMETRICAL  WITH  RFSPECT  TO  THE  X-Z  PLANE. 
EQUAL  BUT  OPPOSITE  LATERAL  MOTION  IS 
PERMITTED.  NSYM(K)  MUST  EQUAL  -J . 


NOTE  : IN  THE  ABOVE  SYMMETRY  OPTIONS,  THE  USER  MUST  TAKE  EXTREME 
CARE  THAT  ALL  INPUT  WILL  ALLOW  THE  SYMMETRY  TO  EXIST. 


IF  NSD  # 0,  NSD  D .8  CARDS  ARE  REQUIRED  BY  SUBROUTINE  SINPUT. 


CARDS  D.8.A  - D.8.J 
(NSD  CARDS) 


FORMAT  ( ^ 13 , IIF6.0) 


MSDM ( J ) 
MSDN ( J ) 


SEGMENT  IDENTIFICATION  NUMBERS  (M  AND  N) 

TO  WHICH  THE  JTH  SPRING  DAMPER  IS  ATTACHED. 


APSDM( I , J) , 1=1 ,3  COORDINATES  OF  ATTACHMENT  POINTS  IN  LOCAL 
APSDN( I , J) , 1=1,3  SEGMENT  REFERENCE  ON  SEGMENTS  M AND  N FOR 

THE  JTH  SPRING  DAMPER  (IN.) 


ASD( I, J) ,1=1, 5 


1=1 

: 

DO 

(IN) 

1=2 

: 

AI 

(LB/IN) 

1=3 

: 

A.2 

(LB/IN**2) 

1=4 

: 

B 1 

(LB  SEC/IN) 

1=5 

: 

B2 

(LB  SEC**2/ 

COEFFICIENTS  OF  QUADRATIC  FUNCTIONS  TO 
COMPUTE  THE  SPRING  FORCE  (FS)  AND  THE 
VISCOUS  FORCE  ( FD ) FOR  THE  JTH  SPRING 
DAMPER  USING  THE  RELATIONSHIPS 

IN**2  ) 


FS=  (D— DO ) * ( | A 1 | + A2*|D-D0|) 
FD=  DV* ( B1  + B 2 * I DV | ) 


WHERE  D AND  DV  ARE  THE  DISTANCE  AND  ITS  TIME 
DERIVATIVE  BETWEEN  THE  POINTS  APS DM  AND  APSDN. 
IF  Al  < 0.  AND  (D-DO)  < 0., 

PROGRAM  WILL  SET  FS=  0.,  I.E.  THIS  WILL  ACT  AS 
TENSION  ELEMENT. 
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E 


SUBROUTINE  C1NPUT  (FUNCTIONS  INPUT) 


THESE  FUNCTIONS  ARE  REFERRED  TO  BY  NUMBER  IN  THE  NF  ARRAYS  REQUIRED 
ON  CAROS  F.l.B,  F.2.B,  F.3.B  AND  F.4.B.  THEY  ARE  USED  TO  DEFINE  THE 
FORCE  DEFLECTION,  INERTIAL  SPIKE,  R (ENERGY  ABSORPTION)  FACTOR, 

G (DEFLECTION)  FACTOR  AND  FRICTION  COEFF1CENT  FUNCTIONS. 

EACH  FUNCTION  MAY  BE  SUBDIVIDED,  IF  DESIRED,  INTO  TWO  SEPARATE  PARTS, 
FI  AND  F2,  WHERE 

F 1 (D ) IS  DEFINED  FOR  0 .LE.  DO  .LE.  D .LE . |D1| 

F2(D)  IS  DEFINED  FOR  1 01 1 .LE.  D .LE.  |D2|. 


IN  ADDITION,  EACH  PART  OF  EACH  FUNCTION  MAY  BE  DEFINED  IN  EITHER 
OF  THREE  FUNCTIONAL  FORMS:  CONSTANT  VALUE,  TABULAR  DATA,  OR  A FIFTH  DEGRE 
POLYNOMIAL.  THE  EXISTENCE  AND  FORM  OF  EACH  FUNCTION  PART  IS  DETERMINED  B 
THE  SUPPLIED  VALUES  OF  DO,  Dl,  AND  02  AS  FOLLOWS: 


FI 

F 2 

DO 

Dl 

D2 

constant 

- 

0 

0 

FI  = 1 

TABULAR 

- 

DO 

• GE.  0 

Dl  .LT.  0 

0 

POLYNOMIAL 

- 

DO 

• GE  • 0 

Dl  .GT.  0 

0 

TABULAR 

POLYNOMIAL 

DO 

•GE  • 0 

Dl  .LT.  0 

D2  .GT 

POLYNOMIAL 

TABULAR 

DO 

• GE.  0 

Dl  .GT.  0 

D2  .LT 

POLYNOMIAL 

POLYNOMIAL 

DO 

• GE.  0 

Dl  .GT.  C 

D2  .GT 

0 

0 

0 


THE  CONSTANT  FORM  IS  APPLICABLE  TO  FI  ONLY  BECAUSE  THE  ROUTINES  ASSUME 
IF  D .GT.  | D2 | THEN  FID)  = F(  |D2|  ) FOR  D2  .NE . 0 OR 

IF  D .GT.  | Dl | THEN  FID)  = F(  |D1|  ) FOR  D2  = 0. 

THE  CASE  OF  BOTH  FI  AND  F2  BEING  TABULAR  IS  EINNECESSARY. 
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A MAXIMUM  OF  50  FUNCTIONS  MAY  BE  SUPPLIED  TO  THE  PROGRAM.  THESE 
FUNCTIONS  MAY  BE  OF  THE  TYPES  DESCRIBED  ON  EITHER  CARDS  E.1-E.4, 
CARDS  E.6  OR  CARDS  E.7. 


CARD  E.l  FORMAT  (14,  4X,  5A4) 

I THE  FUNCTION  IDENTIFYING  NUMBER.  THESE 

NUMBERS  NEED  NOT  BE  SUPPLIED  IN  NUMERIC 
ORDER.  IF  THE  SAME  NUMBER  IS  USED  MORE 
THAN  ONCE,  A WARNING  WILL  BE  PRINTED  AND 
THE  LAST  ONE  SUPPLIED  WILL  BE  USED.  THE 
END  OF  THE  FUNCTION  INPUT  IS  INDICATED  BY 
SUPPLYING  A SINGLE  CARD  WITH  I > 50. 


KT1TLE  A 20  CHARACTER  ALPHANUMERIC 

TITLE  DESCRIBING  THE  FUNCTION. 
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CARD  E.2 


FGRMAT  (3F12.0) 


DO  THE  LOWER  ABSCISSA  VALUE  OF  THE  FIRST  PART 

OF  THE  FUNCTION,  FI.  DO  MUST  BE  NUN-NEGATIVE 
(UNITS  ARE  IN.  EXCEPT  FOR  THE  BELT  STRESS- 
STRAIN  FUNCTIONS  WHERE  THEY  ARE  IN/IN). 

D 1 THE  MAGNITUDE  OF  DI  IS  THE  UPPER  ABSCISSA 

VALUE  OF  FI  AND  THE  LOWER  ABSCISSA  VALUE  OF 
F2,  IF  ANY.  Dl  < 0 INDICATES  FI  IS  TABULAR, 

Dl  > 0 INDICATES  FI  IS  A POLYNOMIAL,  AND 
DI  = 0 INDICATES  FI  = D2 , A CONSTANT. 

D2  IF  Dl  = 0,  D2  IS  THE  CONSTANT  VALUE  OF  FI. 

OTHERWISE,  THE  MAGNITUDE  OF  02  IS  THE  UPPER 
ABSCISSA  VALUE  OF  F2 . IF  D2  = 0,  F2  IS  NOT 
DEFINED;  IF  D2  IS  NEGATIVE,  F2  IS  TABULAR; 

AND  IF  D2  IS  POSITIVE,  F2  IS  A POLYNOMIAL. 

D3  IF  THE  FUNCTION  IS  TO  BE  USED  FUR  AN  INERTIAL 

SPIKE,  D3  REPRESENTS  THE  ABSCISSA  VALUE  FOR 
WHICH  THE  INERTIAL  SPIKE  IS  TO  BE  IGNORED  IF 
UNLOADING  OCCURS  AFTER  DFFLECTION  EXCEEDS  D3. 

IF  THE  FUNCTION  IS  TO  BE  USED  FOR  A COEFFICIENT 
OF  FRICTION,  D3  = <l+U)/2  WHERE  U IS  THE 
COEFFICIENT  OF  RESTITUTION  FOR  THE  IMPULSE 
OPTION  ( 0<D3< 1 OR  -1<U<+1).  A VALUE  OF  D3  = 0 
MEANS  THAT  THE  IMPULSE  OPTION  WILL  NOT  BE 
USED  FOR  THOSE  CONTACTS  USING  THIS  FUNCTION. 
WHEN  THE  GLOB ALGRAPHIC  OPTION  IS  USED,  A 
FRICTION  FUNCTION  IS  DEFINED  AND  THE  VALUE 
OF  D3  IS  USED  TO  SPECIFY  THE  IMPULSE. 

(SEE  CARD  B.5.) 

DA  IF  THE  FUNCTION  IS  TO  BE  USED  AS  A FORCE 

DEFLECTION  FUNCTION  BY  SUBROUTINE  PLELP, 

DA=RHO,  THE  SCALAR  THAT  DETERMINES  THE 
POINT  OF  FORCE  APPLICATION.  SUPPLY  ZERO 
FUR  POINT  OF  MAXIMUM  PENETRATION,  ONE  FOR 
CENTER  OF  INTERSECTION  ELLIPSE.  IF  USED  AS 
THE  FRICTION  FUNCTION  FOR  A ROLL -SLIDE  CON- 
STRAINT, DA  IF  THF  COEFFICIENT  OF  STATIC 
FRICTION  TO  BE  USED  FOR  THE  ROLL  CONSTRAINT. 
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THE  DEFINITIONS  OF  FI  AND  F2,  IF  THEY  EXIST,  ARE  NOW  SUPPLIED 
ON  CARD  E.3  FOR  THE  FIFTH  DEGREE  POLYNOMIAL  DEFINITION,  OR  ON 
CARDS  E.4  FOR  THE  TABULAR  DEFINITION. 


CARD  E.3  FORMAT  (6F12.0) 

A0,A1,A2,A3,A4,A5  COEFFICIENTS  OF  FIFTH-DEGREE  POLYNOMIAL 

F = AO  + A I *X  + A2*X**2  ♦ A3*X**3  + A4*X**4 
♦ Ai>*X**5 

(UNITS  ARE  DEPENDENT  ON  USE  OF  FUNCTION.) 


CARD  E.4.A 


FORMAT  (16) 


NPI  THE  NUMbER  OF  DATA  POINTS  TO  BE 

SUPPLIED  TO  IDENTIFY  THE  FUNCTION  IF 
IT  IS  DEFINED  IN  TABULAR  FORM. 


CARDS  E.A.B  - E.4.N  FORMAT  (6F12.0) 

(X(1),Y(I),I=1,NPI)  THE  AbSCISSA  AND  ORDINATE  VALUES 

OF  THE  DATA  POINTS  USED  TO  DEFINE 
THE  TABULAR  FORM  OF  THE  FUNCTION. 

THE  PROGRAM  WILL  LINFARLY  INTERPOLATE 

TO  DETERMINE  INTERMEDIATE 

VALUES.  SUPPLY  3 POINTS  PER  CARD; 

USE  AS  MANY  CARDS  AS  REQUIRED. 

(UNITS  ARE  DEPENDENT  ON  USE  OF  FUNCTION.) 
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SUBROUTINE  KINPUT  (WIND  FORCE  AND  JOINT  RESTORING  FORCE  FUNCTIONS) 

CARD  E .5  IS  ALWAYS  REQUIRED  AFTER  THE  END-OF-DATA  CARD  E.I  (I  > 50). 
MAY  BE  BLANK  TO  DESIGNATE  NO  FUNCTIONS  ON  CAROS  E .6  OR  fc.7. 


CARD  E.5 

FORMAT  (216) 

NWINDF 

THE  NUMBER  OF  WIND  FORCE  FUNCTIONS  TO  BE 
SUPPLItD  ON  CARDS  E.6.A-E.6.N.  MAY  BE  ZERO. 

NJNTF 

THE  NUMBtR  OF  JOINT  RESTORING  FORCE  FUNCTIONS 
TO  BE  SUPPLIED  ON  CAROS  E.7.A-E.7.N.  MAY 
BE  BLANK  OR  ZERO. 

NWINDF  SETS  OF  CARDS 

E.6.A  - E.6.N  ARE  REQUIRED. 

CARD  E.6.A 

FORMAT  (14,  4 X , 5A4) 

I, KTITLE 

SAME  AS  CARD  E.I  EXCEPT  THAT  EACH  FUNCTION 
NUMBER  (I)  MUST  BE  LESS  THAN  51  AND  MUST  BE 
DISTINCT  FROM  THOSE  SUPPLIED  ON  CARDS  E.I. 

CARD  E.6.B 

FORMAT  (5F12.0) 

DO  t01»D2 ,D3,04 

CURRENTLY  NOT  USED  BY  PROGRAM. 

CARD  E.6.C 

FORMAT  (16) 

NTMPTS 

THE  NUMBER  OF  TIME  POINTS  OR  CARDS  REQUIRED 
TO  DEFINE  THIS  FUNCTION  ON  CARDS  E.6.D-E.6.N. 

CARDS  E.6.D  - E.6.N 
(NTMPTS  CARDS) 

FORMAT  (4F12.0) 

T 

TIME  (SEC.)  SINCE  INITIAL  PENETRATION  OF 
BOUNDARY  PLANE.  VALUES  SHOULD  BE  IN  ASCENDING 
ORDER  WITH  FIRST  VALUE  EQUAL  TO  ZERO. 

FX , FY» FZ 

THE  X* Y AND  Z COMPONENTS  OF  FORCE  PER  UNIT 
ARtA  ( LBS./IN .**2 ) IN  INERTIAL  REFERENCE 
DUE  TO  THE  WIND  BLAST  FORCE  AT  TIME  T.  THE 
PROGRAM  WILL  USE  LINEAR  INTERPOLATION  ON  T. 
IF  LAST  VALUE  OF  T IS  EXCEEDED,  THE  LAST 
VALUES  OF  FX,FY  AND  FZ  WILL  BE  USED. 
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NJNTF  (FROM  CARD  E.5)  SETS  OF  CARDS  E.7.A 


E.7.N  ARE  REQUIRED 


CARD  E.7.A 

FORMAT  (14,  4X,  5A4) 

I tKTITLE 

SAME  AS  CARD  E.l  EXCEPT  THAT  EACH  FUNCTION 
NUMBER  (I)  MUST  BE  LESS  THAN  51  AND  MUST  BE 
DISTINCT  FROM  THOSE  SUPPLIED  ON  CARDS  E.l 
OR  CARDS  E.6.A. 

CARD  E.7.B 

FORMAT  (5F12.0) 

D0,D1,D2,D3,D4 

CURRENTLY  NOT  USED  BY  PROGRAM. 

CARD  E.7.C 

FORMAT  (216) 

NTHETA 

MAGNITUDE  INDICATES  THE  NUMBER  OF  COLUMNS 
IN  THE  TWO  DIMENSIONAL  INPUT  DATA  MATRIX 
TO  BE  SUPPLIED  ON  CARDS  E.7.D-E.7.N.  THE 
MINIMUM  VALUE  IS  2.  IF  POSITIVE,  THE  NTHETA 
ENTRIES  IN  EACH  ROW  WILL  BE  TABULAR  DATA  FOR 
EQUALLY  SPACED  VALUES  OF  THE  JOINT  FLEXURE 
ANGLE  (THETA)  BETWEEN  0 AND  180  DEGREES. 

IF  NEGATIVE,  THE  ENTRIES  WILL  REPRESENT  THE 
COEFFICIENTS  OF  A (—NTHETA— I ) ORDER 
POLYNOMIAL  IN  ( THETA -T HETAO ) 

NPHI 

NUMBER  OF  ROWS  OF  MATRIX  OF  DATA  TO  BE  SUPPLIED 
ON  CARDS  E.7.D-E.7.N.  EACH  ROW  REPRESENTS 
EQUALLY  SPACED  VALUES  OF  THE  JOINT  AZIMUTH 
ANGLE  (PHI)  BETWEEN  -180  AND  +180  DEGREES, 

BUT  DOES  NOT  INCLUDE  THE  LAST  ROW  SINCE  THE 
PROGRAM  ASSUMES  DATA  FOR  PHI ( NPH 1+1 ) =180  ARE 
THE  SAME  AS  FOR  PHI(i)=-180.  MINIMUM  = 1. 

CARDS  E.7.D  - E.7.N 
(NPHI  SETS  OF  CARDS. 

FORMAT  (5F12.0) 

USE  EXTRA  CARDS  PER  SET  IF  |NTHETA|  > 5.) 

THETAO 

THE  VALUE  OF  THE  "DFAD  BAND"  ZONE  FOR  THIS 
VALUE  OF  PHI  (DEGREES).  IF  THE  FLEXURE 
ANGLE  (THETA)  IS  LESS  THAN  THETAO,  THE 
JOINT  RESTORING  FORCE  WILL  BE  ZERO. 

F(J),J=2, NTHETA 

FOR  NTHETA  POSITIVE,  TABULAR  VALUES  OF  THE 
JOINT  RESTORING  FORCE  FOR  FLEXURE  ANGLES 

THETA(J)  = ( J-1)*I80/(NTHETA-I)  DEGREES 

VALUES  OF  ZERO  SHOULD  BE  SUPPLIED  FOR 
THETA  < THETAO. 

FOR  NTHETA  NEGATIVE,  THE  COEFFICIENTS  OF  A 
POLYNOMIAL  IN  ( THETA— THET AO ) OF  ORDER  ONE 
LESS  THAN  THE  MAGNITUDE  OF  NTHETA.  F(J)  IS 
THE  COEFFICIENT  OF  ( THETA— THETAO )**( J— I) 

WHERE  (THETA— THETAO)  IS  EXPRESSED  IN  RADIANS. 
F ( I ) IS  ASSUMED  TO  BE  ZERO. 
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F.  SUBROUTINE  FINPUT  (ALLOWED  CONTACTS  AND  ASSOCIATED  FUNCTIONS) 

IF  NPL  it  0,  F.l  IS  REQUIRED. 

CARD  F.l. A FORMAT  (1814)  IF  NPL>18,  USE  2 CARDS. 

MNPL( J ) , J=1 ,NPL  FOR  PLANE  J,  THE  NUMBER  OF  SEGMENTS  FOR 


WHICH  SEGMENT-PLANE  CONTACT  IS  ALLOWED. 

NPL  IS  THE  NUMBER  OF  PLANES  FROM  CARD  D.l. 
THE  VALUE  OF  ANY  MNPL  FOR  PLANE  J MAY  BE 
ZERO  AND  THE  MAXIMUM  VALUE  IS  5.  HOWEVER  IF 
IT  IS  REQUIRED  TO  HAVE  MORE  THAN  t>  SEGMENTS 
CONTACT  THE  SAME  PLANE,  SET  UP  TWO  OR  MORE 
IDENTICAL  PLANES  AND  PERMIT  A MAXIMUM  OF  5 
SEGMENTS  TO  CONTACT  EACH  PLANE. 

FOR  EACH  PLANE  J, 

MNPL(J)  CARDS  OF  THE  FOLLOWING  MUST  BE  SUPPLIED. 

CARDS  F.l.B  - F.l, 

.N  FORMAT  (914) 

NJ 

THE  PLANE  NUMBER  FOR  WHICH  CONTACT  IS 
ALLOWED.  NJ  MUST  CORRESPOND  TO  J ABOVE. 
THERE  MUST  BE  MNPL(J)  CARDS  WITH  THIS 
SAMt  NJ.  IF  MNPL(J)  = 0,  NO  NJ  = J 
SHOULD  BE  PRESENT. 

NSC  I) 

THE  SEGMENT  NUMBER  TO  WHICH  PLANE  J IS 
ATTACHED.  IF  VEHICLE,  SUPPLY  NSEG+1,  IF 
GROUND,  SUPPLY  NSEG+2. 

NS  ( 2 ) 

THE  SEGMENT  NUMBER  (DETERMINED  BY  THE  CARO 
NUMBER  1 UNDER  CARD  B.2.A  FOR  WhILH  CONTACT 
WITH  THE  NJTH  PLANE  IS  ALLOWED. 

NS  ( 3 ) 

THE  NUMBER  OF  THE  CONTACT  ELLIPSOID 
ASSOCIATED  WITH  THE  SEGMENT  NS(2). 
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NF ( 1 » THE  FUNCTION  NUMBER  FROM  CARO  t.l  TO  DEFINE 

THE  FORCE-DEFLECTION  FUNCTION  FOR  THIS  CONTACT. 
IF  NF ( 1 ) =0,  A ROLLING  - SLIDING  CONSTRAINT 
OPTION  WILL  BE  EXERCISED  BY  THE  PROGRAM  FOR 
THIS  CONTACT  WHICH  DOES  NOT  REQUIRE  NF(Z), 

NF ( 3 ) OR  NF ( A ) BUT  DOES  REQUIRE  A FRICTION 
COEFFICIENT  FUNCTION  TO  BE  DEFINED  BY  NF(5). 

THE  VALUE  OF  D3  ON  CARD  E .2  OF  THIS  FUNCTION 
SHOULD  BE  0.5  (NON-ZERO  TO  ACTIVATE  THE 
IMPULSE  AND  TO  SET  THE  NORMAL  COMPONENT 
OF  RELATIVE  VELOCITY  TO  ZERO  AFTER  THE 
IMPULSE  HAS  BEEN  APPLIED).  ALSO  THE  INITIAL 
POSITIONS  ON  CARDS  C-.2  MUST  BE  SUCH  THAT 
CONTACT  DOES  NOT  EXIST  AT  TIME  = 0. 

NF ( 2 ) THE  FUNCTIUN  NUMBER  FROM  CARD  E.l  TO 

DEFINE  THE  INERTIAL  SPIKE  FUNCTION 
FUR  THIS  CONTACT.  IF  NF(2)  = 0»  NO 
INERTIAL  SPIKE  EXISTS. 

NF ( 3 ) THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO 

DEFINE  THE  R ( ENERGY-ABSORPTION)  FACTOR 
FUNCTION.  IF  NF ( 3 ) = 0,  A DEFAULT  VALUE 
OF  R = 1 IS  ASSUMED. 

NF ( A ) THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO  DEFINE 

THE  G (DEFLECTION)  FACTOR  FUNCTION.  IF 

NF ( 4 ) = 0»  A DEFAULT  VALUE  OF  G = 0 IS  ASSUMED. 

NF ( 5 ) THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO 

DEFINE  THE  FRICTION  COEFFICIENT  FUNCTION. 
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IF  NBLT  # 0,  F.2  IS  REQUIRED 


CARD  F.2. A 

MNBLT ( J ) » J = 

FOR  EACH  BELT  J 

CARDS  F.2.B  - F 
NJ 

NSC  1) 

NS  (2) 

NS  C 3 ) 

NFC1) 

NFC  I), 1=2, < 
NFC5) 


FORMAT  C 814 ) 

1 , NBLT  FOR  BELT  J,  THE  NUMBER  OF  SEGMENTS  FOR 

WHICH  SEGMENT-BELT  INTERACTION  IS  ALLOWED. 
NBLT  IS  THE  NUMBER  OF  BELTS  FROM  CARD  D.l. 
EACH  MNBLT  MAY  HAVE  A VALUE  OF  0 OR  1 ONLY. 


, MNBLT ( J ) CARDS  OF  THE  FOLLOWING  MUST  BE  SUPPLIED. 


.2  »N  FORMAT  (914) 

THE  BELT  NUMBER  TO  BE  CONTACTED, 

MUST  CORRESPOND  TO  J ABOVE. 

THERE  MUST  BE  MNBLTCJ)  CARDS 

WITH  THE  SAME  NJ.  IF  MNBLTCJ)  = 0, 

NO  NJ  = J SHOULD  BE  PRESENT. 

THE  SEGMENT  NUMBER  TO  WHICH  BELT  NJ  IS 
ATTACHED.  IF  VEHICLE,  SUPPLY  NSEG+1,  IF 
GROUND,  SUPPLY  NSEG+2. 

THE  SEGMENT  NUMBER  (DETERMINED 
BY  THE  CARD  NUMBER  I UNDER 
CARD  B.2.A)  FOR  WHICH  INTERACTION 
WITH  THE  NJTH  BELT  IS  ALLOWED. 

THE  NUMBER  OF  THE  CONTACT  ELLIPSOID 
ASSOCIATED  WITH  THE  SEGMENT  NS (2 ) • 

THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO  DEFINE 
THE  FORCE-DEFLECTION  FUNCTION  FOR  THIS  CONTACT. 
THE  ABSCISSA  FOR  THIS  FUNCTION  SHOULD  BE 
STRAIN  (IN/IN). 

► SAME  DEFINITION  AS  ON  CARD  F.l.B  ABOVE. 

IF  NON-ZERO,  FULL  BELT  FRICTION  IS  ASSUMED, 
I.E.,  FORCES  ARE  COMPUTED  FOR  EACH  HALF  OF 
THE  BELT  SEPARATELY.  IF  ZERO,  ZERO  BELT 
FRICTION  IS  ASSUMED,  I.E.,  BELT  TENSION  IS 
IS  THE  SAME  AT  BOTH  BELT  ANCHOR  POINTS. 
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A BLANK  F.3.A  CARD  IS  REQUIRED  FDR  NO  SEGMENT-SEGMENT  CONTACTS 


CARD  F.3.A 
MNSEG( J)  ,J=1,NSEG 

FOR  EACH  SEGMENT  J 

CARDS  F.3.B  - F.3. 
NJ 

NS  ( 1 ) 

NS  (2) 

NS  ( 3 ) 

NF(I), 1=1,5 


FORMAT  ( 1 81 A)  IF  NSEG>18,  USE  TWO  CARDS. 

FOR  SEGMENT  J,  THE  NUMBER  OF  SEGMENTS  FOR 
WHICH  SEGMENT-SEGMENT  CONTACT  IS  ALLOWED. 

NSEG  IS  THE  NUMBER  OF  SEGMENTS  FROM  CARD 
B.l.  EACH  SEGMENT  CONTACT,  A VERSUS  B,  MAY 
BE  INPUTTED  EITHER  WAY  EXCEPT  WHERE  AN 
INTERIOR  CONTACT  IS  DESIRED  (SEE  NS (3)  ). 

ANY  OR  ALL  VALUES  OF  MNSEG  MAY  BE  ZERU. 

THE  MAXIMUM  VALUE  FOR  EACH  MNSEG  IS  5. 

MNSEG ( J ) CARDS  OF  THE  FOLLOWING  MUST  BE  SUPPLIED. 


FORMAT  (9IM 

THE  SEGMENT  NUMBER  TO  BE  CONTACTED, 

MUST  CORRESPOND  TO  J ABOVE.  THERE  MUST 
BE  MNSEG ( J ) CARDS  WITH  THIS  SAME  NJ . 

IF  MNSEG ( J ) = 0,  NO  NJ  = J SHOULD  BE 
PRESENT. 

THE  NUMBER  OF  THE  CONTACT  ELLIPSOID 
ASSOCIATED  WITH  SEGMENT  NJ. 

THE  SEGMENT  NUMBER  (DETERMINED 
BY  THE  CARD  NUMBER  I UNDER 
CARD  B.2.A)  FOR  WHICH  CONTACT 
WITH  THE  NJTH  SEGMENT  IS  ALLOWED. 

THE  NUMBER  OF  THE  CONTACT  ELLIPSOID 
ASSOCIATED  WITH  THE  SEGMENT  NS(2). 

IF  NEGATIVE,  AN  INTERIOR  CONTACT  WILL  BE 
ASSUMED  WITH  ELLIPSOID  NS(1)  INSIDE  NS(3). 

SAME  DEFINITIONS  AS  ON  CARD  F.l.B  ABOVE. 
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IF  NJNT  > 0,  F.4.A  IS  REQUIRED. 

SUPPLY  IGL0B=1  FOR  GLOBALGRAPHIC  OPTIUN,  OTHERWISE  SUPPLY  0 OR  BLANK 


CARD  F.4.A 

FORMAT  (1814)  IF  NJNT>I8,  USE  TWO  CARDS. 

IGLOB( J)  ,J  = 1,NJNT 

FOR  EACH  JOINT  J,  SUPPLY  I FOR  IGLOB(J)  IF 
IPIN(J)  IS  +3  OR  -3  ON  CARDS  B.3.A  - B.3.J; 
OTHERWISE  SUPPLY  ZERO  OR  PLANK.  ONE  CARD 
F.4.J  MUST  BE  SUPPLIED  BELOW  FOR  EACH  J FOR 
WHICH  IGLOB(J)  =1. 

CARDS  F.4.B  - F.4.J 

FORMAT  (914) 

NJ 

THE  IDENTIFICATION  NUMBER  FOR  A GLOBALGRAPHIC 
JOINT,  MUST  CORRESPOND  TO  J ABOVE  AND  CARDS 
MUST  BE  SUPPLIED  IN  ASCENDING  ORDER  ON  NJ. 

NS ( I ) ,1=1,3 

CURRENTLY  NOT  USED  BY  PROGRAM. 

NF  ( I ) 

THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO  DEFINE 
THE  TORQUE-DEFLECTION  FOR  THIS  GLOBALGRAPHIC 
JOINT.  THE  ORDINATE  FOR  THIS  FUNCTION  SHOULD 
BE  TORQUE  (IN.  LB.)  AND  THE  ABSCISSA  IS  THE 
ANGULAR  DtFLECTION  (RADIANS)  INTO  THE  STOP. 

NF  ( 2 ) 

THE  FUNCTION  NUMBER  FROM  CARD  E.l  TO  DEFINE 
THE  HERRON  FORMULAS  FOR  T (JOINT  STOP  ANGLE 
IN  RADIANS)  AND  ITS  DERIVATIVE  TP  WITH  RES- 
PECT TO  PHI  BOTH  AS  FUNCTIONS  OF  PHI  (THE 
JOINT  ANGLE  FROM  THE  REFERENCE  AXIS  IN  RAD- 
IANS). NORMALLY  THEY  WILL  BE  COMPUTED  BY 

T = PI  + SP*P2 
TP  = PI*  ♦ CP*P2  + SP*P2  * 

WHERE  PI,P2  ARE  THE  5TH  DEGREE  POLYNOMIAL 
EVALUATIONS  OF  COS(PHI)  USING  THE 
TWO  POLYNOMIALS  FI  AND  F2  OBTAINED  BY 
SETTING  BOTH  D1,D2  > 0 ON  CARD  E.2; 

P 1 * , P2  * ARE  THEIR  DERIVATIVES  WITH 
RESPECT  TO  PHI? 

AND  CP,SP  ARE  COS ( PHI ) AND  SIN(PHI). 

IF  D1,U2  ARE  NOT  BOTH  POSITIVE,  T AND  TP 
WILL  BE  EVALUATED  AS  FUNCTIONS  OF  PHI  IN 
RADIANS  (0  < PHI  < 2*PI)  AS  SPECIFIED  ON 
CARDS  E.l  - E.4  FOR  FUNCTION  NF(2). 

SAME  DEFINITIONS  AS  ON  CARD  F.I.B  ABOVE 
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IF  NJNT  > 0,  CARD  F.5.A 

IS  ALWAYS  REQUIRED  BUT  MAY  BE  BLANK. 

CARD  F.5.A 

FORMAT  (1814)  USE  TWO  CARDS  IF  NJNT  > 18. 

JOINTF (J  )»J=I»NJNT 

FOR  EACH  JOINT  (J),  THE  FUNCTION  IDENTIFIC- 
ATION NUMBER  AS  SUPPLIED  ON  CARDS  E.7.A  TO 
BE  USED  BY  SUBROUTINE  VISPR  TO  COMPUTE  THE 
JOINT  RESTORING  FORCE  BY  FUNCTION  FNTERP. 

IF  ZERO,  THE  VALUES  OF  SPRING ( 1, 3*J-2 ) AS 
SUPPLIED  ON  CARDS  B.4.A  WILL  BE  USED  USING 
FUNCTION  EJOINT • 

IF  NBAG  # 0,  NB AG  CARDS 

OF  THE  FOLLOWING  MUST  BE  SUPPLIED.  SINCE 

THE  AIR  BAG  ROUTINES  DO  NOT  USE  THE  FORCE— DEFLECTION  FUNCTIONS,  THIS 
INPUT  HAS  DIFFERENT  FORMATS  THAN  THE  ABOVE  ALLOWED  CONTACTS. 


CARDS  F.6.A  - F.6.N 

FORMAT  (214,  2012) 

K 

THE  AIR  BAG  NUMBER  CORRESPONDING  TO  THE 
INDEX  J UNDER  CARDS  D.4  ABOVE.  K MUST  BE  IN 
NUMERIC  ORDER  K = 1 TO  NBAG,  WHERE  NBAG  IS 
THE  NUMBER  OF  AIR  BAGS  DEFINED  ON  CARD  D.I. 

NK 

THE  NUMBER  OF  SEGMENTS  ALLOWED 
TO  CONTACT  THE  KTH  AIR  BAG.  THE 
MAXIMUM  VALUE  IS  10.  IF  NK  = 0, 

THE  REMAINDER  OF  THE  CARD  IS  BLANK. 

MB AG(2 , I ,K  ) , 
MBAG(3,I,K) ,1=1, NK 

THE  SEGMENT  NUMBERS  (DETERMINED  BY  THE 
CARD  NUMBER  I UNDER  CARD  B.2.A)  EACH 
FOLLOWED  BY  THE  NUMBER  OF  THE  ASSOCIATED 
CONTACT  ELLIPSOID  FOR  WHICH  CONTACT 
FORCES  WITH  THE  KTH  AIR  BAG  WILL  BE 
COMPUTED. 
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CARD  F.7.A  IS  ALWAYS  REQUIRED.  INSERT  A BLANK  CARD  IF  NO  WIND 
FORCE  CALCULATIONS  ARE  TO  BE  PERFORMED. 


CARD  F.7.A  FORMAT  (1814)  USE  TWO  CARDS  IF  NSEG  > 18. 

MWSEGl 1»J) »J=1 »NSEG  FOR  EACH  SEGMENT  J,  SUPPLY  ZERO  IF  NO  WIND 

FORCE  CALCULATIONS  ARE  TO  BE  PERFORMED. 
OTHERWISE*  SUPPLY  A VALUE  OF  ONE  TO  INDICATE 
WIND  FORCES  ARE  TO  BE  PERFORMED. 

SUPPLY  CARD  F.7.B  FOR  EACH  SEGMENT  CJ)  WHERE  MWSEGl I, J)  = i. 


CARD  F.7.B 

FORMAT  (£>14) 

JJ 

THE  SEGMENT  IDENTIFICATION  NUMBER  FROM  CARDS 
B.2.A  FOR  WHICH  WIND  FORCE  CALCULATIONS  ARE 
TO  BE  PERFORMED.  MUST  CORRESPOND  TO  J FROM 
CARD  F.7.A  AND  BE  SUPPLIED  IN  ASCENDING  ORDER 

MWSEGl 2*  J ) 

THE  NUMBER  UF  THE  CONTACT  ELLIPSOID  TO  BE 
ASSOCIATED  WITH  SEGMENT  NUMBER  JJ. 

MWSEGl 3, J ) 

THE  SEGMENT  IDENTIFICATION  NUMBER  (NSEG+1 
FUR  THE  VEHICLE*  NSEG+2  FOR  THE  GROUND) 
ASSOCIATED  WITH  PLANE  NUMBER  MWSEG  (4,J). 

MWSEGl 4, J) 

THE  PLANE  IDENTIFICATION  NUMBER  FROM  CARD 
D.2.A  THROUGH  WHICH  IF  SEGMENT  J PASSES, 
WIND  FORCE  CALCULATIONS  WILL  BE  PERFORMED. 

MWSEG15, J) 

THE  FUNCTION  NUMBER  FROM  CARD  E.6.A  FOR  THE 
WIND  FORCE  FUNCTION  TO  BE  USED. 
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F.8  SUBROUTINE  HINPUT  - CARD  INPUT  FOR  HARNESS-BELT  SYSTEMS 


CARD  F.8.A  IS  ALWAYS  REQUIRED.  INSERT  BLANK  CARD  IF  NO  HARNESS- 
BELT  SYSTEMS  ARE  DESIRED. 


CARD  F.8. A 

FORMAT  (614) 

NHRNSS 

NUMBER  OF  HARNESS-BELT  SYSTEMS  TO  BE 
SUPPLIED  ON  CARDS  F.8.B-F.8.D.  MAY  BE  ZERO 
OR  BLANK • MAXIMUM  VALUE  = 5. 

NBLTPH ( I ) ♦ 

I = I »NHRNS  S 

NUMBER  OF  INDIVIDUAL  BELTS  FOR  EACH  HARNESS 
NO.  I.  MAY  BE  ZERO  OR  BLANK.  MAXIMUM  VALUE 
OF  SUM  OF  ALL  NBLTPH  IS  20. 

CARD  F.8.A  IS  FOLLOWED 

BY  NHRNSS  SETS  OF  CARDS  F.8.B  - F.8.D. 

CARD  F.8.B 

FORMAT  (1814)  USE  TWO  CARDS  IF  NBLTPH ( I ) >1 8 . 

NPTSPB ( J ) ♦ 
J=ItNBLTPH( I ) 

THE  NUMBER  OF  REFERENCE  POINTS  INCLUDING 
ANCHOR  POINTS  FOR  BELT  NO . J OF  HARNESS 
NO.  I.  MAY  BE  ZERO  OR  BLANK.  THE  MAXIMUM 
VALUE  OF  THE  SUM  OF  ALL  NPTSPB  FOR  ALL 

harness-belt  systems  is  100. 

EACH  CARD  F.8.B  IS  FOLLOWED  BY  NBLTPH(I)  SETS  OF  CARDS  F.8.C  - F.8.D. 


CARD  F.8.C 

FORMAT  (514,  FI2.6) 

NFBLT (L,J),L=1,5 

THE  IDENTIFICATION  NUMBERS  OF  THE  5 FUNCTIONS 
TO  BE  USED  FOR  BELT  NO.  J.  THESE  CORRESPOND 
TO  I AS  SUPPLIED  ON  CARDS  E . 1 OF  THE  FUNCTION 
DEFINITIONS.  THESE  FUNCTIONS  ARE  IDENTICAL  TO 
THOSE  DEFINED  BY  NF(I)  - NF(5)  ON  CARDS  F.2.B 
EXCEPT  THAT  THE  COEFFICIENT  OF  FRICTION  AS 
SPECIFIED  BY  NF(5)  IS  NOT  CURRENTLY  USED. 

XLONG<  J) 

BELT  SLACK  (IN).  THE  SLACK.  WHEN  ADDED  TO 
THE  INITIAL  GEOMETRIC  LENGTH,  RESULTS  IN 
THE  INITIAL  BELT  LENGTH.  IF  DESIRED,  THE 
INITIAL  BELT  LENGTH  MAY  BE  SUPPLIED  AS  A 
NEGATIVE  NUMBER  AND  THE  PROGRAM  WILL 
COMPUTE  THE  SLACK. 

65 


EACH  CARD  F.8.C  I 
REFERENCE  POINTS 

CARD  F.8.D 

IBAR( l,K| 

IBAK ( 2 *K ) 

BAR (L,K ) »L=1, 


FOLLOWED  BY  NPTSPB(J)  CARDS  F.8.D  SPECIFYING  THE 
K)  TO  BE  USED  FOR  BELT  NO.  J OF  HARNESS  NO.  I. 

FORMAT  (216,  3F12.6) 

THE  IDENTIFICATION  NUMBER  OF  THE  SEGMENT 
ASSOCIATED  WITH  REFERENCE  POINT  K. 

THE  IDENTIFICATION  NUMBER  OF  THE  CONTACT 
ELLIPSOID  ASSOCIATED  WITH  POINT  K.  IF  ZERU, 
PROGRAM  WILL  ASSUME  BELT  IS  RIGIDLY  ATTACHED 
TO  THAT  POINT  (AS  FOR  ANCHOR  POINTS  ATTACHED 
TO  THE  VtHICLE I . 

THt  X, Y AND  Z COORDINATES  OF  REFERENCE  POINT 
K IN  THE  LOCAL  COORDINATE  SYSTEM  OF  SEGMENT 
NO.  IBAK(ltK).  THE  PROGRAM  WILL  ASSUME  THAT 
BELT  J WILL  RUN  THROUGH  THE  POINTS  IN  THE 
ORDER  THEY  ARE  SUPPLIED.  HOWEVER  IF  A CONTACT 
ELLIPSOID  IS  SPECIFYED  BY  IBAR(2,K»  AND  THE 
THE  FORCES  ARE  SUCH  AS  TO  PULL  THE  bELT  AWAY 
FROM  THE  SURFACE,  THIS  POINT  WILL  BE  IGNORED 
THAT  TIME  POINT. 
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SUBROUTINE  INITAL 


CARD  G.I  FORMAT  (3F10.0,  514) 

ZPLT(I ) ,1=1,3  THE  X,  Y,  AND  Z PLOT  COORDINATES 

(FOR  SUBROUTINE  PRIPLT)  OF  THE 
ORIGIN  OF  THE  VEHICLE  REFERENCE 
SYSTEM.  0 < X < 61 

0 < Y < 61 

0 < Z < 121 


1 1 , J 1 , 12  » J2  NOT  USED  BY  THE  CURRENT  PROGRAM. 

13  IF  ZERO,  SEGMENT  AND  ANGULAR  VELOCITIES  ARE 

NOT  SUPPLIED  ON  THE  FOLLOWING  CARDS  BUT  ARE 
SET  EQUAL  TO  THE  INITIAL  VEHICLE  VELOCITY. 

IF  13  # 0,  SEGLV  AND  WMGDEG  MUST  BE  SUPPLIED. 


ONE  G.2  CARD  MUST  BE  SUPPLIED  FOR  EACH  REFERENCE  SEGMENT  (I.E., 
SEGMENT  NO.  1 AND  FOR  EACH  SEGMENT  J+I  WHERE  JNT(J)  = 0 UN  CARDS 
B.3)  IN  ASCENDING  SEGMENT  NUMBER  SEQUENCE. 


CARDS  G.2. A - G.2.M  FORMAT  (6F10.0) 

SEGLP( I , J) ,1  = 1 ,3  THE  INITIAL  X,  Y,  AND  Z COORDINATES  OF  THE 

JTH  BODY  SEGMENT  IN  INERTIAL  REFERENCE  (IN). 

SEGLV (I, J), 1=1, 3 THE  INITIAL  X,  Y,  AND  Z COMPONENTS  OF  VELOCITY 

OF  THE  JTH  BODY  SEGMENT  IN  INERTIAL  REFER- 
ENCE (IN/SEC).  THESE  FIELDS  MAY  BE  LEFT  BLANK 
IF  13  = 0 ON  CARD  G.I  IN  WHICH  CASE  THE 
INITIAL  VELOCITY  OF  THE  VEHICLE  WILL  BE  USED. 


CARDS  G.3.A  - G.3.N  FORMAT  (6F10.0) 

(NSEG  CARDS) 

YPR(I,J),I=I,3  THE  INITIAL  YAW,  PITCH  AND  ROLL  ANGLES  OF 

THE  JTH  BUOY  SEGMENT  (DEGREES). 

NOTE:  THE  DIRECTION  COSINE  MATRICES  OF  THE  BODY  SEGMENTS  ARE  INITIALLY 
COMPUTED  BY  ASSUMING  THE  ORDER  OF  THE  ROTATING  ANGLES  IS  REVERSED, 
I.E.,  ROLL, PITCH, YAW. 

(ROLL  ABOUT  X,  PITCH  ABOUT  Y,  AND  YAW  ABOUT  Z.) 

WMGDEG(I.J) ,1=1,3  THE  INITIAL  COMPONENTS  OF  ANGULAR  VELOCITY 

ABOUT  THE  LOCAL  X,Y  AND  Z AXES  OF  THE  JTH 
BODY  SEGMENT  (DEG/SEC).  IF  13  = 0 ON  CARD 
G.I,  THE  INITIAL  ANGULAR  VELOCITY  OF  THE 
VEHICLE  WILL  BE  CONVERTED  TO  THE  SEGMENT 
REFERENCE  AND  WILL  BE  USED. 
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H.  SUBROUTINE  HEDING 

THIS  SUBROUTINE  PROVIDES  INPUT  TU  CONTROL  THE  DESIRED  TIME  HISTORY 
OUTPUT  OF  SELECTED  SEGMENT  LINEAR  AND  ANGULAR  ACCELERATIONS,  VELOCITIES, 
AND  DISPLACEMENTS,  AND  JOINT  PARAMETERS. 

H.l  SEGMENT  LINEAR  ACCELERATIONS  (K  = 1) 


CARD  H.l. A 

FORMAT  (216,  3F12.6) 

NSG(K) 

THE  NUMBER  OF  SELECTED  POINTS  ON 
THE  VARIOUS  BODY  SEGMENTS  FOR 
WHICH  TIME  HISTORIES  ARE  DESIRED. 

THE  MAXIMUM  VALUE  FOR  NSG(K)  IS  20. 

IF  NSG(K)  IS  0,  INSERT  2 BLANK  CARDS. 
IF  NSG(K)  IS  1,  A SINGLE  BLANK  CARD 
SHOULD  FOLLOW  CARD  H.l.K. 

MSG ( 1 , K ) 

THE  SEGMENT  NUMBER  AS  DETERMINED 

BY  INDEX  I ON  CARDS 

B.2.A  - B.2.N  OF  THE  FIRST  POINT. 

XSG< 1,1, K) ,1=1,3 

THE  X,  Y,  AND  Z COORDINATES  IN 
SEGMENT  REFERENCE  OF  THE  FIRST 
POINT  (INCHES). 

FOLLOWbD  BY  NSG(K>-1 

CARDS  OF  THE  FOLLOWING  (J  = 2,  NSG(K)  ) 

CARDS  H.l.B  - H.l.N 

FORMAT  (112,  3F12.6) 

MSG ( J,  K ) 

SAME  AS  ABOVE  BUT  FOR  THE  JTH  POINT. 

XSG(I,J,K>, 1=1,3 

SAME  AS  ABOVE  BUT  FOR  THE  JTH  POINT. 

H.2  SEGMENT  LINEAR  VELOCITIES  (K  = 2) 

CARDS  H.2. A - H.2.N  FORMAT  (216,  3FI2. 6/(112,  3F12.6)) 

DESCRIPTION  SAME  AS  FOR  H.l. 

H.3  SEGMENT  LINEAR  DISPLACEMENTS  (K  = 3) 

CARDS  H.3. A - H.3.N  FORMAT  (216,  3F12. 6/(112,  3F12.6)) 

DESCRIPTION  SAME  AS  FOR  H.l. 
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H.4  SEGMENT  ANGULAR  ACCELERATIONS  (K  = 4) 


CARD  H.4 

FORMAT  ( 1216/ I 12,  316) 

NSG(K) 

THE  NUMBER  OF  SELECTED  BODY 
SEGMENTS  FOR  WHICH  TIME  HISTORIES 
ARE  DESIRED.  INSERT  BLANK  CARD 
IF  NONE  ARE  DESIRED  (NSEG  MAXIMUM). 

MSG ( J » K ) » J = 1 1 KSG 
WHERE  KSG=NSG ( K ) 

THE  SEGMENT  NUMBERS  AS  DETERMINED 
BY  INDEX  I ON  CARDS  B.2.A  - B.2.N. 

IF  NSG(K)  > II,  USE  THE  SECOND  CARD, 
LEAVING  THE  FIRST  FIELD  OF  6 COLUMNS  BLANK 
IF  NSG(K)  = 11,  A SECOND  CARD,  COMPLETELY 
BLANK,  SHOULD  FOLLOW  THIS  CARD. 

H.5  SEGMENT  ANGULAR  VELOCITIES  (K  = b) 

CARO  H.b  FORMAT  <1216/112,  316) 

DESCRIPTION  SAME  AS  FOR  H.4. 

H.6  SEGMENT  ANGULAR  DISPLACEMENTS  (K  = 6) 


CARD  H.6 

FORMAT  (1216/112,  316) 

DESCRIPTION  SAME 

AS  FOR  H.4. 

H.7  JOINT  PARAMETERS  (K  = 

= 7) 

CARD  H.7 

FORMAT  (1216/ I 12,  216) 

NSG(K) 

THE  NUMBER  OF  SELECTED  JOINTS  FOR 
WHICH  TIME  HISTORIES  ARE  DESIRED. 
INSERT  BLANK  CARD  IF  NONE  ARE 
DESIRED  ( NJNT  MAXIMUM). 

MSG(JfK) , J = I » KSG  THE  JOINT  NUMBERS  AS  DETERMINED 


WHERE  KSG=NSG ( K ) 

BY  INDEX  J ON  CARDS  B.3.A  - 
B.3.J.  IF  NSG(K)  > II,  USE  A 
SECOND  CARD  LEAVING  THE  FIRST  FIELD 
OF  6 COLUMNS  BLANK.  IF  NSG(K)  = 11, 
A SECOND  CARD,  COMPLETELY  BLANK, 
SHOULD  FOLLOW  THIS  CARD. 
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APPENDIX  B 


The  listing  of  21  subroutines  that  follow  represent  the  changes  or 
additions  that  were  made  to  the  computer  program  contained  in  Volume  IV, 
Programmer's  Manual  of  Calspan  Report  No.  ZQ-5180-L-1,  "An  Improved  Three 
Dimensional  Computer  Simulation  of  Motor  Vehicle  Crash  Victims,"  July  1974 
to  fulfill  the  requirements  of  Wright  Patterson  AFB  Contract  No.  F33615-75- 
C-5002.  Any  subroutine  not  contained  herein  remains  unchanged  from  the 
above  mentioned  report. 

The  following  is  a list  of  the  included  subroutines  and  a summary  of 
the  changes  that  have  been  made  to  them. 

1.  SUBROUTINE  CINPUT:  Statement  numbers  have  been  renumbered  for  reada- 
bility and  previous  version  has  been  subdivided  into  new  SUBROUTINE 

CINPUT  and  SUBROUTINE  FINPUT.  Calls  to  new  subroutines  KINPUT  and  HIN- 
PUT  have  been  added. 

2.  SUBROUTINE  CONTCT:  Card  No.'s  140-160  and  780-1050  have  been  added  to 

control  the  calling  of  SUBROUTINE  WINDY  and  SUBROUTINE  HBELT. 

3.  SUBROUTINE  DINT:  Card  No.'s  530  and  2150-2170  have  been  modified  to 

simplify  program  logic  and  are  equivalent  to  previous  version. 

4.  SUBROUTINE  ELTIME:  Card  No.'s  210  and  220  have  been  modified  to  include 

SUBROUTINE  WINDY  and  SUBROUTINE  HBELT  for  N=35  and  36. 

5.  FUNCTION  EVALFD:  Extensive  modifications  have  been  made  to  accomodate 

abscissas  that  exceed  the  range  of  tabular  function  definitions. 

6.  SUBROUTINE  FINPUT:  New  subroutine  that  is  actually  the  second  half  of 

previous  SUBR0UINTE  CINPUT  that  controlled  the  input  specifying  allowed 
contacts  between  body  segments  with  vehicle  panels,  belts,  airbags  and 
other  body  segments.  New  code  has  been  inserted  at  card  no.'s  2100-2280 
for  new  input  card  F.5  defining  joint  functions  to  be  used.  Old  input 
cards  F.5  have  been  renamed  F.6  and  new  code  has  been  inserted  at  card 
no.'s  2540-2800  for  input  cards  F.7  controlling  the  new  wind  force  cal- 
culations . 
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APPENDIX  B (Continued) 

7.  SUBROUTINE  FLXSEG:  Card  No.’s  130  and  140  have  been  interchanged  to 

properly  control  the  call  to  SUBROUTINE  ELTIME. 

8.  FUNCTION  FNTERP : New  subroutine  that  computes  the  restoring  torque 

of  a joint  by  double  linear  interpolation  on  the  flexure  angle  (theta) 
and  azimuth  angle  (phi) . 

9.  SUBROUTINE  HBELT : New  subroutine  that  computes  the  forces  and  torques 

of  individual  belt  sections  of  the  harness-belt  systems. 

10.  SUBROUTINE  HINPUT:  New  subroutine  that  controls  the  input  of  cards 

F.8.A-F.8.D  containing  the  setup  and  control  of  the  harness-belt  system. 

11.  SUBROUTINE  IMPULS:  Card  No.’s  1810  and  1820  have  been  modified  to  prop- 

erly control  call  to  SUBROUTINE  ELTIME. 

12.  SUBROUTINE  KINPUT:  New  subroutine  that  controls  the  input  of  cards 

E.5,  E.6  and  E.7  containing  the  definitions  of  the  wind  force  and  joint 
restoring  force  functions. 

13.  SUBROUTINE  OUTPUT:  Card  No.’s  1280-1300  have  been  modified  to  print 

the  joint  angles  in  degrees  for  the  new  joint  functions. 

14.  SUBROUTINE  PLELP:  Comments  in  card  no.’s  50  and  60  have  been  corrected. 

15.  SUBROUTINE  RSTART : Card  No.’s  630-640,  1480-1580,  1630-1640,  1770,  1890, 
1970,  2060,  2150,  2170-2180,  2930  and  4410-4620  have  been  modified  or 
added  to  insert  JOINTF  in  COMMON/ DESCRP/  and  to  include  COMMON/ HARNESS/ 
and  COMMON/ KALEPS/ . 

16.  SUBROUTINE  SEARCH:  Several  additions  and  modifications  have  been  made  to 

accomodate  the  changes  made  to  SUBROUTINE  RSTART. 
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APPENDIX  B (Continued) 


17.  SUBROUTINE  UPDATE:  Card  No.'s  360-370,  1020-1210  have  been  added  to 

call  SUBROUTINE  UPDFDC  for  each  belt  of  harness-belt  systems  and  card 
no.  2400  has  been  modified  to  set  initial  state  of  rolling-sliding 
constraint . 

18.  SUBROUTINE  VEHP0S : Card  No.'s  410-440  and  1100-1110  have  been  modified 
to  extrapolate  beyond  last  entry  in  vehicle  position  input  tables. 

19.  SUBROUTINE  VINPUT:  Card  No.'s  560,  600  and  750-810  have  been  modified  to 

permit  input  of  negative  VIPS  on  input  card  C.2  and  delete  the  restriction 
that  the  last  acceleration  on  card  C.3  be  zero. 

20.  SUBROUTINE  VISPR:  Card  No.'s  190,  310,  560-570,  600-870,  930,  1090-1100, 

1190-1230,  1350-1410,  1450,  1470-1480,  1500,  1560,  1580,  1650-1670,  1800, 
1830-1840,  1990-2000  and  2020  have  been  added  or  modified  to  include  the 
necessary  logic  for  the  new  joint  functions. 

21.  SUBROUTINE  WINDY:  New  subroutine  that  computes  the  forces  and  torques  of 

a wind  blast  acting  on  specified  body  segments. 
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SUBROUTINE  CINPUT 


10 


I 1 
12 


13 


REV  12 

CONTROLS  THE  CARC  INPUT  UF  THE  FORCE-DE FLECT ICN , INERTIAL  SPIKE, 

R FACTOR,  G FACTOR  AND  FRICTION  COEFFICIENT  FUNCTION  DEFINITIONS 

IMPLICIT  REAL*B( A-H,0“Z) 

COMMON/TAB LES/MXNT I , MXNT B,MXTB 1 ,MXTB2 ,NT I (50 ) ,NTAB(5C0 ) , TAB (2 000) 
COMMO N/TEMP VS/ JTITLE(5*  31) » NF  ( 5)»NS(3) ,KTITLE( 31) 

REAL  J TI T LE, K TI TLE 
IS  = 0 

DO  lu  I = 1,50 
NT  I ( I ) = 0 
J1  = 1 

INPUT  CARD  E.l  - FUNCTION  NO.  AND  TITLE,  IF  NO.  > 30  SKIP  OUT. 


) ,J  = 1,3) 


READ  ( 3,12 ) I , (KTI TLE ( J 
FORMAT  (I4,4X,3A4) 

IF  ( I.GT.30)  GO  TO  30 
DO  13  J = 1,3 
JTITLE(J«I)  = KTITLE(J) 


HAS  FUNCTION  NO.  BEEN  ALREADY  USED? 


IF  ( NT  1 ( I ) .Nl.G  ) WRIT  fc (6 , 14 ) I 
14  FORMAT! *0  FUNCTION  NO.1, 14,*  HAS 
♦REPLACED  BY  NEXT  FUNCTION') 

NT  I ( I ) = J1 
J2  = J 1+4 

INPUT  CARD  E. 2 


ALREADY  BEEN  INPUTTED  AND  WILL 


READ  (3,15)  (TAB(J)«J  = J1,J2) 

13  FORMAT  (6F12.0) 

IS  = 1-IS 

IF  (IS.LQ.O)  WRITE  (6,16) 

16  FORMAT!/////) 

WRITE  (6,17)  IS,  I , ( JTITLL!  J,I)  ,J  = 1,5)  ,1  ,NTI  ( I)  , (TABU  ) ,J=J1,  J2) 

17  F0RMATU1,  'FUNCTION  NO.  ' ,1  4,  4X  ,3A4 ,20X,  • NTI  ( • , I 2 , ' ) =',I3,43X 


12/18/74C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

BEC 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


♦ 'CARDS  E'//10X, 'DO* ,13X,'D1 ' , 13X , »D2' , 13X, • D3 • ,13X, • D4 • /3F 13 .4// ) C 


DO  = TAB(Jl) 

D1  = TABCJI+l) 

D2  = TAB(Jl+2) 

JI  = J2  + 1 

IF  (Dl)  22,18 , 2 u 

FUNCTIGN  IS  CONSTANT  D2  FOR  ALL  D , 


18 

19 


WRITE  (6,19)  D2 
FO  RM  AT ( 7X , 'FUNCTION 


IS  CCNSTANT' ,F  12.6  ) 


INPCC10 
INP002C 
INPC036 
IN  PC  040 
IN PC 030 
INPCG6C 
INP0070 
INPC080 
IN  PC  090 
INP0100 
INPOilO 
INPC12G 
INPC130 
IN  PC  140 
I N Pu 1 30 
INPG16C 
IN  Pu 1 70 
INP0180 
IN  PC  190 
INP02GG 
INPU210 
INPC220 
IN  PC  230 
INPG240 
INP0230 
INP026C 
INP0270 
IN PC  2 80 
INP029C 
IN  PC  30G 
INPG31C 
INPG32G 
INP033G 
INPG340 
INP035G 
IN  PC  360 
IN  PC  370 
INPC38G 
INP0390 
IN  PC  400 
IN  Pc4 10 
IN  Pu42  u 
INPG430 
INP0440 
INPu430 
INPG46G 
INPG470 
INP048C 
INPG490 
INPG500 
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GO  TO  11 


5TH  ORDER  POLYNOMIAL 
INPUT  CARD  E.3 


1ST  FUNCTION 


20 


J2  = J 1+5 
READ(5,15) ( TAB ( J ) , J = J1,J2) 

WR I TE ( 6 ,2 1 ) (TAB(J)»J  = J1,J2) 

21  FORMAT (7Xf • FIRST  PART  OF  FUNCTION  - 5TH  DEGREE  POLYNOMIAL1// 

* 8 X , ’ AO* , 13X,#A1*,13X, ,A2t,13X,#A3l»13X,,A4,,13X,fA5#, 

* 6F15.6//) 

J1  = J2+1 

GO  TO  25 

TABLE  LOAD  ...  1ST  FUNCTION 
INPUT  CARDS  E.4.A-E.4.N 

22  RE AD ( 5,23)  NPI 

23  FORMAT  (1216) 

TA8(J1)  = NPI 
J1  * Ji+l 

J2  * J1+2*NPI-1 
READ(5,15) (TAB (J ),J  = J1,J2) 

WRITE  (6,24)  NPI,  ( TAB  ( J)  ,J  = Jl,  J2  ) 

24  F0RMAT(7X,  • FIRST  PART  OF  FUNCTION  - M4,'  TAbULAR  POINTS1// 

* 8 X , f D • , 16X , • F( D ) f /( F 15. 6, FI 5. 4) ) 

Jl  = J 2 + 1 

CHECK  FOR  SECOND  FUNCTION 


25  IF ( D2  ) 28,11,26 

SECOND  FUNCTION 
INPUT  CARD  E.3 


5TH  ORDER  POLYNOMIAL 


26  J2  = Jl+5 

READ(5,15) ( TA8 ( J ) , J = J1,J2) 

WRITE  (6,27)  (TAB(J)tJ  = J1,J2) 

27  F0RMAT(7X, ’SECOND  PART  OF  FUNCTION  - 


5TH  DEGREE  POLYNOMIAL »// 


8X,»8Cf  ,13X,  ’B1M3X,  *82  • ,13X,  »B3*  , 13X,’ 
6F15 .6//) 


28 


Jl  = J2+1 
GO  TO  11 

SECOND  FUNCTION  ...  TABLE  LOAD 
INPUT  CARDS  E.4.A-E.4.N 

READ (5,23)  NPI 
TA  8 ( J 1 ) = NPI 
Jl  * Jl+1 


CINP0510 
C INPG52G 
CINPC530 
C INPG54G 
C IN PC  550 
C INP056C 
C INP0570 
C INP058C 
C INPG59G 
13X/C INPG600 
CINPG610 
C IN  PC  620 
CINP0630 
CINP0640 
CINP0650 
CINPC660 
C INP067C 
CINPG680 
C INP0690 
C INPG70G 
CINPG710 
C INP0720 
C INPC730 
CINPC74G 
CINP075O 
C INPG760 
CINP0770 
CINP0780 
C INP0790 
C IN  PO  800 
C IN  Pu  8 10 
CINPC820 
C INP0830 
C IN  PO  840 
C IN  PC  850 
C INP086G 
C IN  Pu8  7u 
C INP0880 
C IN  PC  690 
13X/C INPG9GC 
C IN  PC  910 
C INPG92G 
C IN  PC  930 
CINPG940 
CINPG95G 
C INPG96C 
CINPC97G 
CINPG980 
C INPC99G 
CINP1C00 
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J2  = J 1 +2*NPI- 1 
READ(5,15) (TAB(J) ,J  = J1,J2) 

WRITE ( 6 ? 29 ) NPIt  (TAb(J),  J = J1,J2) 

29  FORM AT ( 7Xf  f SECOND  PART  OF  FUNCTION  - *fI4,'  TABULAR  POINTS*// 

♦ 8 X f f D f f I6X » * F ( D ) * /<P15.6,F15.4) ) 

J1  = J 2+1 
GO  TO  11 

30  MXTB1  = Jl-1 
CALL  KINPUT 
CALL  FINPUT 
CALL  HINPUT 
RETURN 

END 


CINP1G10 
CINP1020 
CINP1G30 
C IN  P 1 040 
CINP1C50 
C IN  PI  060 
C IN PIC  70 
CINP108C 
C IN  PI090 
C IN  PI  100 
C IN  PI  1 1 0 
CINP1120 
CINPll3o 
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SUBROUTINE  CONTCT 


REV  12 


C0NT0010 

12/19/74C0NTG020 


CONTROLS  THE  CALLING  OF  SUBROUTINES  REQUIRED  TO  COMPUTE  THOSE 
EXTERNAL  FORCES  AND  TORQUES  ACTING  ON  THE  BODY  SEGMENTS# 

IMPLICIT  REALMS  (A-H,0-Z) 

COMMON/CONTRL/NSEG,NJNT,NS3,NJ3,NPL,NBLT ,NB AG,NVEH ,NGRND , NPRT (40) 
COMMON /JB ARTZ/  MNPL ( 20),MNBLT(  6 ) ,MNSEG(  22 ) ,MN6  AG ( 6), 

* MPL(3,5,20),MBLT(3,5, B) ,MSEG< 3 , 5, 22 ) , MBAG ( 3, 10 ,6 ) , 

* NT PL (5, 20), NT BLT(5, 8), NTS  EG (5, 22) 

COMMON /FORCES/ PS F ( 7,20)  , BS F ( 4, 20 ) , SSF(  10,20) , B AGSF (3 , 20 ) , 

* NPSF,NBSF ,NSSF,NBGSF,NPANEL(6) ,PRJNT(6,21) 
COMMON/TAB LES/MXNTI, MXNTB, MXTB 1, MXTB2 , NT 1( 50 ),NTAB( 500), TAB (2000) 
COMMON/KA  LE  PS/WTIML ( 30 ) ,IWIND( 30) ,MWSEG( 5,22) 

COMMON/HRNES S/  BAR(6,100)  , XLQNG(20),  IBAR(2,100),  NTHRNS ( 20 ) , 

* NHRNSS,  NBLTPH ( 5 ) , NFBLT(5,20),  NPTSPB(20) 

CALL  E LT1ME ( 1 , 12 ) 

NPSF  = 0 
NBSF  = 0 
NSSF  = 0 

IF  (NPL.LE.O)  GO  TO  21 

CALL  PLELP  ROUTINE  FOR  EACH  ALLOWED  PLANE-SEGMENT  CONTACT# 


GO  TO  20 


19 

20 
21 


DO  20  J=1 , NPL 
IF (MNPL( J) • EQ • 0 ) 

KPL  = MNPL(J) 

DO  19  1=1, KPL 
NPSF  = NPSF+1 
Ml  = MPL ( 1 , 1 , J ) 

M2  = MPL ( 2 , 1 , J ) 

M3  = MPL( 3 , 1 , J ) 

NT  = NTPL ( I ,J  ) 

JT  = NTAB(NT) 

TAB  ( J T ) = 0#0 

CALL  PLELP ( M2 , M3 ,M1, J,NT ) 

CONTINUE 

IF (NBLT #LE.C)  GO  TO  41 

CALL  BELTRT  ROUTINE  FOR  EACH  ALLOWED  BELT-SEGMENT  CONTACT. 

DO  30  J=1 , NBLT 

IF ( MN BLT( J ) #EQ#0)  GO  TO  30 

KB  L T = MNBLT(J) 

DO  29  1=1 , KBLT 


NBSF 
Ml  = 
M2  = 
M3  = 
NT  = 


= NBSF  + 1 
MBLT( 1,1  ,J) 
MBLT( 2,1, J) 
MBLT ( 3 , 1 , J ) 
NTBLT ( 1,J) 


C ONT003C 
C0NT0040 
C 0NT0050 
C 0NT0060 
CON TO 070 
C0NT0080 
C0NT009C 
CON TO  100 
C ONTO  1 10 
CONT0120 
CONT0130 
C0NT0140 
CONTO150 
C0NTC160 
C0NT0170 
C0NT0180 
C0NTG19G 
C ONT0200 
C ON  T 0 2 1 0 
C 0NT022G 
C ONTO  230 
C 0NT0240 
C ONT0250 
C0NT0260 
CQNT0270 
C ONT0280 
CONTG290 
C0NT0300 
C ONTO  3 10 
C0NT0320 
C0NT0330 
CON TO 340 
C0NT035C 
C0NT0360 
CONT0370 
C0NTO3B0 
C0NTO390 
CDNT0400 
C0NT0410 
C0NT0420 
C ON  T 0 43  u 
C0NT0440 
CON  TO 4 50 
CONT0460 
CONT047C 
C ONTO 480 
C 0NT049G 
C0NT0500 
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JT  = NT  AB ( NT ) 

TAB ( JT  ) = O.C 
NF  = NTAB( NT+5) 

IF  (NF.NE.O)  JT  = NT  AB ( NT+6) 

IF  (NF.NE.O)  TAB ( JT ) = G.O 

29  CALL  BELTRT(M2*M3,M1,J,NT) 

30  CONTINUE 

CALL  SEGSEG  ROUTINE  FOR  EACH  ALLOWED  SEGMENT “SEGMENT  CONTACT. 

41  DO  50  J=1 1 NStG 

IF (MNSEGtJ ) . EQ .0  ) GO  TO  50 
KS  EG  = MNSEG(J) 

DO  49  1=1 * KSEG 
NS  SF  = NS  S F ♦ 1 
Ml  = MSEG ( 1 i I *J) 

M2  = MSEG ( 2 tit J) 

M3  = MSEG(3»ItJ) 

NT  = NTSEG ( I » J ) 

JT  = NTAB(NT) 

TAB(JT)  = 0.0 

49  CALL  SEGSEG(J,MlfM2*M3,NT) 

50  CONTINUE 

CALL  AIRBAG  ROUTINE  FOR  ALLOWED  BAG-SEGMENT  CONTACTS*  IF  ANY. 
IF  (NBAG.NE.O)  CALL  AIRBAG 

CALL  WINDY  ROUTINE  FOR  WIND  FORCES  ON  EACH  SEGMENT. 

DO  60  J=1  * NSEG 

IF  (MWSEG(  1 * J ) • EQ.O ) GO  TO  60 
Ml  = MWSEG ( 2 * J ) 

M2  = MWSEG ( 3*  J ) 

M3  = MWSEG ( 4*  J ) 

NT  = MWSEG ( 5 * J ) 

CALL  WINDY  ( J * Ml , M2 , M3 , NT ) 

60  CONTINUE 


C ON  T 0 5 1 0 
C0NTi>520 
C0NT05  30 
C0NT054C 
C0NTG550 
C0NTG56C 
C ON  T 0 5 7 0 
C0NT05B0 
C0NT0590 
C0NTu600 
C ON  TO  6 10 
CONT062G 
CONT0630 
C0NT0640 
C0NT065C 
C 0NT0660 
C0NTC670 
C0NTG68C 
CON  TO  690 
C0NTU700 
C0NT0710 
C0NT0720 
C0NTC730 
C0NT074G 
C0NTG750 
C0NTG76G 
C0NT0770 
C0NT078G 
CONTC790 
CONT0800 
C0NT081G 
C0NTC820 
C0NTG630 
C0NTGB4G 
C0NT085C 
C 0NTuB6G 
C0NTG87G 
C0NT088C 
CON  TO  890 


CALL  HBELT  ROUTINE 

FOR 

EACH  HARNESS-BELT  SYSTEM. 

CONTC90G 

C0NT0910 

IF 

(NHRNSS.LE .0)  GO 

TO 

99 

C 0NT0920 

J1 

= 1 

C0NTO930 

K1 

= 1 

CONT0940 

DO 

70  1=1*  NHR  NSS 

C0NTG95G 

IF 

(NBLTPH(I).LE.O) 

GO 

TO  70 

CONT0960 

J2 

= J1  ♦ NBL  T PH ( I) 

-1 

C0NT0970 

DO 

69  J=J1*J2 

C0NT098  0 

IF 

(NPTSPB(J) • LE .0 ) 

GO 

TO  69 

C0NTG990 

K2 

= K1  ♦ NPTSPB(J) 

-1 

C0NT1C00 

77 


CALL  HBELT(NPTSPBU)  , IBAR( lf K1  )f  BARll.  K1  ) t NTHRNS(  J ) ,XLONG(  J)  ) 
K1  = K2+1 

69  CONTINUE 
J1  = J 2+1 

70  CONTINUE 

99  CALL  ELTIME (2  » 12 ) 

RETURN 

END 


CONTICIO 
C0NT1020 
CONTiO  3C 
C ON T ICAO 
C0NTIw5G 
C0NT1C6C 
C0NTI070 
C0NT1C80 
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SUBROUTINE  0INT( IN , N , DT P R, HO ,HMAX , HMI N , /T/ , X , 0 ER , NOI NT ) 0INT001C 

REV  12  10/25/74D IN TO 020 


EXECUTIVE  ROUTINE  USED  FOR  PERFORMING  AN  INTEGRATION 
STEP  BETWEEN  PRINT  TIME  POINTS. 

ARGUMENTS 

IN:  INTEGRATION  STEP  NUMBER 
N:  NO  OF  VARIABLES  10  BE  SUPPLIEO  AS  INPUT  TO  ROUTINE 
OR  COMPUTED  BY  SUBROUTINE  PDAUX  WHEN  K=0  (MAX=12C). 
OTP  R : PRINT  TIME  INTERVAL  OESIRED 
HC  2 INITIAL  INTEGRATION  STEP  SIZE 
HM AX : MAXIMUM  INTEGRATION  STEP  SIZE 
HM IN  2 MINIMUM  STEP  SIZE 
T2  TIME 

X:  ARRAY  OF  STATE  VARIABLES 
OER:  ARRAY  OF  DERIVATIVES  OF  STATE  VARIABLES 
N 0 1 NT  2 NUMBER  OF  ESTIMATES  OF  INTEGRATION  PARAMETERS 

TO  BE  MAOE  AT  THE  ENO  OF  ANY  INTERMEDIATE  TIME  STEP. 


0 INT0030 
0 INT0040 
0 INTO  050 
OINT0060 
D INTC070 
0 INT008  0 
0 INT009C 
DINT0100 
0INT011G 
D INTO  120 
0 INTO  130 
DINT0140 
DINT0150 
D INTO  160 
0INT0170 
D INTO 180 
0INT019C 

IMPLICIT  REAL *8  (A-H,0-Z)  DINT0200 

COMMON/CONTRL/  NSEG,NJNT,NS3,NJ3,NPL,NBLT,NBAG, NV  EH, NGRNO  , NPRT  <4 G ) 0 INTO 2 1C 
COMMON/ INTEST/  SG TES T ( 3 * 4, 22 ) , XTEST < 264 ) DINT0220 

COMMON/CNSNTS / PI,  RADI  AN, G, THIRO, EPSl,  EPS4, EPS6, EPS8,  0INT623G 

* EPS12,EPS15,EPS2G,EPS24, UNITL , UNIT M»UN ITT ,GRAVTY( 3)0  IN TO 240 


COMMON/COINT/  E ( 3 , 120 ) * F (5 , 1 20 ) ,GG ( 5 , 12 0 ) , Y ( 5, 1 20 ) ,U ( 5 , 120 ) 
* ,H,HPRINT,TSAVE,TPRINT,TSTART,ICNT,IDBL,IFLAG 

01  MENS  I ON  X( 120) , OER (120) 


CALL  EL  TIM E (1,3) 

IF  (IN.NE.O)  GO  TO  3 

FIRST  TIME  IN  ROUTINE,  PERFORM  INITIALIZATION  STEP  . 

H = HC 
HPRINT  = H 
I DBL  =3 
IC  NT  = 0 
TPRINT  = T 
CALL  OUTPUT ( 0 ) 

K = 0 

CALL  POAUX ( X, OER ,N ,K ) 

IF  (N.GT.120)  WRITE  (6,9)  N 

FORMAT ( *0  NUMBER  OF  VARIABLES  IN  SUBROUTINE  DINT  IS1, 16, 
* » AND  EXCEEDS  THE  ARRAY  SIZES  OF  120, 

IF  (N.GT.120)  STOP 
DO  1 1=1, N 

F( 1,1  ) = X ( I ) 

F ( 2 , I ) = DER< I) 

F(  3,1)  =0. 


D INT0250 
D INT0260 
DINT0270 
DINTC280 
DINT0290 
0INTG300 
DINTG310 
DINTG32G 
DINT033C 
0INT034G 
D INT0350 
0 INT0360 
DINT0370 
0 INTG38G 
0 IN TO 390 
0 INT0400 
DINT041C 
DINT0420 
DINT0430 
D INT0440 
PROGRAM  TERMINATED. ,)0INT045G 

0 INT0460 
DINTC470 
0 INT0480 
0 INTG490 
DINT0500 
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F ( 4, 1 ) = 0. 

1 F( 5 ♦ I ) = 0. 

GO  70  65 

START  OF  NEW  PRINT  POINT  INTERVAL. 

3 TPRINT  = 7PRIN7+D7PR 
H = HPRINT 

ENTRY  TO  ADVANCE  INTEGRATOR. 

4 K = 1 

CALL  UPDATE(K) 

IF  (K.EQ.l)  GO  TD  2 

RECALL  PDAUX  FDR  IMPULSE  IF  K * — 1 

IF  ( N PRT ( 26 ) .N E. 0 ) CALL  OUTPUT(O) 

CALL  PDAUX (X,DER,N,K) 

IF  ( NPRT ( 26 ) .NE. 0 ) CALL  OUTPUT (1) 

H = HO 
ICNT  = 0 
K = 1 

DO  6 1=1,  N 

f(  i,i ) = xm 

F ( 2 , I ) = DER( I ) 

F( 3 , 1 ) = G.O 
F ( 4, 1 ) = 0.0 
6 F ( 5 ,1  ) = 0.0 

2 HPRINT  = H 

IF  ( T+H+EPS8. GE.T PRINT)  H = TPRINT-T 

ENTRY  TD  BACKUP  INTEGRATOR,  CONVERGENCE  TEST  FAILED. 

5 D 1 = G.5»H 
012=01+01 
D123=H-01 
TSTA  RT  =T 

T =T  START  + D 1 
DO  10  1 = 1, N 

DO  10  J=1 , 5 

U(  J,  I ) =0  • 

Y ( J , I ) =0  • 

10  GG  ( J , I ) = F ( J , I ) 

CALL  DZP(N,X,GG,E,D1,1 ) 

IF  (NPRT(26).NE.O)  CALL  OUTPUT(C) 

CALL  PDAUX ( X, OER ,N ,K ) 

IF  ( NPRT( 26 ) .NE.C ) CALL  OUTPUT(l) 

DD  20  1 = 1, N 

W=X( I ) -GG (1,1) 


D INTO  5 1C 
D INTC52C 
D IN  T0530 
D INTO  540 
DINT0550 
D INT0560 
DIN  TO  570 
D INTO  580 
D INTO  590 
D INTG600 
DINT061G 
DINT0620 
D INT0630 
DINT0640 
DINT0650 
DINT0660 
DINT0670 
D INT0680 
D INT0690 
D INTO  7C0 
DINTG710 
D INTO  720 
DINT0730 
D INT0740 
D INTG75G 
DINT0760 
DINTG77C 
DINTC78C 
DINT079G 
D INTG800 
DINTG810 
DINT0820 
D INT083G 
DINT0840 
DINT085G 
DINTG86G 
DINTG87U 
D INT0880 
D INTO 890 
DINT0900 
DINT0910 
D INTG920 
DINT0930 
DINT0940 
DINT0950 
D INTO  960 
D INTG97G 
D INT0980 
DIN70990 
D INT1G00 
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Z=DE  R ( I )-GG ( 2 » I ) 

D INT1010 

Y(1,I)=Y(1,I)+W 

D INT102C 

Y(2, I)*Y(2,I)+Z 

DINT1030 

Y ( 3 , I ) =Y  ( 3 1 1 ) +W**2 

DINT1Q40 

Y<4,  I )=Y(4,I  )+Z*W 

DINT1050 

GG  ( 2 * I ) = DER(  I ) 

DINT1060 

CALL  DZP(N,X,GG,E,D1,0) 

DINT1070 

K = 2 

DINT1080 

IF  ( NPRT( 26 ) *N E. 0 ) CALL  OUTPUT(O) 

DINT1090 

CALL  PDAUX (X,DER,N,K) 

DINT1100 

IF  (NPRT(26 ).NE.O)  CALL  OUTPUTCI) 

D INTI 1 10 

T =TSTART+H 

D INTI 120 

HI  = EPS1/H 

DINT1130 

DO  30  1 = 1, N 

D INTI 140 

GG ( 2 , I ) = F ( 2, I ) 

D INTI 150 

W=X( I )-GG( 1«I ) 

DINT116C 

Z=DER(I)-GG(2,I) 

D INTI 170 

YC 1»I )*YC Itl)+W 

D INTI 180 

Y ( 2, I ) =Y(  2,1 ) ♦Z 

DINT1190 

Y ( 3 , 1 ) =Y  ( 3 , 1 ) +W**2 

D INT1200 

Y(4,I )=Y(4,I )+Z*W 

D INTI 2 10 

Y(5 ,1 )=Y(3,I )-.5*Y(l, I )**2 

DINT1220 

U(5,I)=Y(4,I  )-*5*Y(  1,1  )*Y(2,I) 

DINT1230 

Z = 0 • 

DINT1240 

IF ( Y ( 5, I ) *NE#0 • )Z=U(5 , I ) /Y ( 5 , 1 ) 

DINT1250 

IF  (Z.GT.H1)  Z = HI 

DINT1260 

GG(5,I)=Z 

D INT1270 

ZYZ  = (Y(2,I)-Z*Y(1,I) )/D12 

D INT1280 

GG ( 4, I ) = 0 #5*GG (4,1) 

D INT1290 

GG  ( 3 , I ) = ZYZ  - Dl*GG(4,n 

D INTI 300 

CALL  DZP (N,X,GG,E,H  ,1) 

DINT1310 

K = 3 

DINT1320 

IF  (NPRT(26).NE.O)  CALL  OUTPUT(O) 

DINT1330 

CALL  PDAUX ( X,DER,N,K) 

D INT1340 

IF  (NPRT(26).NE.O)  CALL  OUTPUT(l) 

DINT1350 

DO  44  L=1,NDINT 

D INTI 360 

Z L=L 

D INTI 370 

ZH=ZL*H 

DINT1380 

DO  40  1=1, N 

D INTI 390 

W=X ( I ) -GG (1,1) 

DINT1400 

Z=DER(I)-GG(2 ,1 ) 

DINT1410 

IF  (DABS(W) .LT.EPS24)  W=0,0 

DINT1420 

IF  (DABS(Z).LT.£PS24)  Z=0.0 

D INT1430 

UClfl  )=U( 1VI)+W 

DINT1440 

U(2,I)=UC2,I)+Z 

DINT1450 

U(3,I )=U(3,I ) +W**2 

DINT1460 

U(4,I)=U(4,I)*W*Z 

DINT1470 

Z=GG (5,1 ) 

D INT1480 

IF(L.EQ.1)G0  TO  35 

DINT1490 

Z=0. 

DINT1500 
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FX=Y(5,I  )+U(  3,1  )-U(  1,1  )**2/ZL 

IF(FX.NE.0.)2=(UC5tI)+U(4*I )-U( 1 , I )*U( 2 ,1 )/ZL )/FX 
IF  (Z.GT.H1)  Z = HI 
35  GG ( 5 , 1 )=Z 

W = m2fI)-Z*Y(l»n  )/D12 
Z= (U ( 2 , 1 ) — Z*U ( 1 ? I ) )/ZH 
GG(3»I)=(H*W-D1*Z)/D123 
40  GG ( 4 , 1 ) = ( Z — W ) /D123 
M = 1 

IF(L.EQ.1)M=0 

CALL  DZP (NfXfGGfEtHfM) 

IF  (L.EQ.NDINT.OR.NPRT( 26) .NE.G)  CALL  OUTPUT(O) 

IF  ( L • EQ.NDINT ) K = 4 
CALL  PDAUX (X,DER,M,K) 

44  IF  (L.NE.NDINT.AND.NPRT(26).NE.O)  CALL  OUTPUT(l) 

TEST  FOR  CONVERGENCE 

IF  (K.LT.O)  GO  TO  47 
DO  46  1 1=1 9 N»  3 

IF  (XTEST( II) .LE.O.O)  GO  TO  46 
TE  = 0.0 
TT  = 0.0 
12  = II+2 
DO  45  1=11,12 

Z=GG(5,I)*(X(I)  — GG( 1,1  ) )+GG  ( 2 , I ) +H*( GG ( 3 , 1 ) +H*GG ( 4, I ) ) 

TE  = TE+(DER(  I )-Z)^2 

45  TT  = TT  +DER ( I ) ♦♦ 2 

IF  (NPRT(25).NE.Q)  WRITE  (6,48)  T , 1 1 ,TT ,T E, ( XTEST ( I ) , I =1 1 , 1 2 ) 
IF  (TT.LT.XTEST( II ) ) GO  TO  46 

IF  (XTESTdI+n.GT.Q.O  .AND.  TE.LT  .XTEST  ( 1 1 + 1 ) ) GO  TO  46 
IF  (TE.GE.XTEST(II+2)*TT)  GO  TO  47 

46  CONTINUE 

CONVERGENCE  SUCCESSFUL 
GO  TO  60 

CONVERGENCE  FAILED,  TEST  TO  DIVIDE  H. 

47  IF  ( N PRT ( 25 ) .EQ.O)  WRITE  (6,48)  T , II ,TT , TE, ( XTEST ( I ) , I =1 1 , 1 2 ) 

48  FORMAT ( *0  DINT  CONV.  TEST1 ,F10.6,I6,5G16.8) 

WRITE  (6,49)  T,H 

49  FORMAT ( *0  TEST  FAILED  AT  TIME  =»,Fl0.6,»  FOR  H =’,F10.6) 

ICNT  = 0 

IF  (H.LE.HMIN)  GO  TO  61 
IF  (NPRT(26).NE.O)  CALL  OUTPUT(l) 

T = T-H 
H = H*G  .5 
K = 2 


DINT151C 
D INTI  520 
D INTI  530 
DINT154C 
D INTI 550 
DINT 1560 
D INTI  570 
D INTI  580 
D INTI 5 90 
D INT160C 
D INT161G 
DINT162C 
DINT1630 
DINT 1 640 
D INT1650 
DINT166C 
D INTI  670 
DINT1680 
D INT169C 
D INTI 700 
D IN  Tl  7 10 
D INTI  72 C 
0 INTI  730 
0 INTI  740 
D INTI  750 
DINT1760 
DINT177U 
D IN  Tl 780 
D INTI  790 
D INTI  800 
D INTI  8 10 
D INTI  820 
DINT1830 
D INTI  840 
D INTI  650 
D INTI 860 
D INTI  870 
D IN  Tl 880 
D INTI 8 90 
DINT19G0 
D IN  Tl 9 10 
DINT192G 
D INT1930 
D INT1940 
D INT1950 
D INTI  960 
D INTI  970 
D IN  Tl 980 
DINT 1 990 
DINT2000 
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GO  TO  5 

60  IF  (H .GT. 0.  74  ♦HP  R I NT  ) ICNT  = ICNT+1 

61  00  6 3 1=1,  N 
F( 1,1 ) = X(I) 

F ( 2 , I ) = DER(I) 

F( 3 , 1 ) = GG(3,I)  +2 . C*H*GG (4,1) 

F ( 4, I ) = GG(4,I) 

63  F( 5,1 ) = GG ( 5 , I ) 

IF (ICNT.LT.IDBL)  GO  TO  65 
ICNT  = G 
H = H*2.0 

IF  (H.GT.HMAX)  H=HMAX 
HPRINT  = 2 #G*HPR INT 
IF  (HPRINT. GT.HMAX)  HPRINT  = HMAX 
65  CALL  U PDAT  E(2 ) 

CALL  OUTPUT ( 1 ) 

IF  ( TPR INT-T.G  E. EPS8 ) GO  TO  4 
CALL  ELTIME(2,3) 

RETURN 

END 


DINT2G10 
DINT2G20 
0 INT2030 
DINT2040 
DINT2G50 
D INT2G6C 
0INT2070 
DINT2080 
DINT2G90 
DINT2100 
DINT211G 
0INT2120 
DINT213G 
DINT214G 
0INT2150 
UINT216G 
0INT21T0 
DINT218G 
0INT2190 
DINT2200 
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SUBROUTINE  ELTIME(LyN) 


E LTI0C1C 
REV  12  12/19/74ELTI0C20 


COUNTS  THE  NUMBER  OF  TIMES  CERTAIN  BASIC  SUBROUTINES  ARC  CALLED 
AND  ACCOUNTS  FUR  ALL  COMPUTER  CPU  TIME  USED  BY  THESE  ROUTINES* 


ARGUMENTS  L: 


Ns 


1 INDICATES  CALL  IS  AT  START  OF  ROUTINE 

2 INDICATES  CALL  IS  AT  END  OF  ROUTINE. 
THE  SUBROUTINE  IDENTIFICATION  NUMBER. 


ASSUMES  FUNCTION  LTIME(I)  IS  GIVING  ELAPSED  CPU  TIME  IN 


ELTI0G30 
ELTIGOAO 
ELTIGC5C 
ELTI0G6G 
ELTIGC70 
ELTI008G 
ELTIG09C 
INTEGER  ELTIG1CG 


UNITS  OF  O.Ol  SECONDS  SINCE  FUNCTION  LTIME(O)  WAS  CALLED. 

COMMCjN/GBTIME/NT  (4C  ) tMT  IN(  40  ) ♦ NC  ( 40  )*IND(40)*NSUB 
RE AL*8  SUB ( 40 ) / 


INITIAL  CALL  AT  BEGINNING  OF  MAIN  PROGRAM. 

MT  I N ( I ) = LTIME(O) 

DO  II  I =1  y 40 


IND(I)  = 
NC  ( I ) 
MTIN(I)  = 
11  NT(I)  = 
NSUB 

IND(I)  = 
NC  ( I ) 

MT IN ( I ) = 
GO  TO  99 


G 

0 

-1 

0 

1 

1 

I 

0 


CALL  AT  BEGINNING  OF  NTH  SUBROUTINE. 

20  IF  (L.GT.l  ) GO  TO  3G 
MTIN(N)  = LTIME(I) 

IF  (NC(N).NE.O)  GO  TO  21 
NSUB  = NSUB  +1 
IND(NSUB)  = N 

21  NC ( N ) = NC ( N ) +1 
GO  TO  99 

CALL  AT  END  OF  NTH  SUBROUTINE. 


ELTIuIIO 
E LT 10120 
ELTIG13C 
E LT  10  I AO 


♦ 

8H 

MAIN3D 

t 8H 

INPUT 

y 8H 

DINT 

y 8H 

PRIPLT 

y 8H 

DZP 

t 

ELTI015C 

♦ 

8H 

PDAUX 

♦ 8H 

UPDATE 

1 8H 

OUTPUT 

y 8H 

DAUX 

♦ 8H 

SETUPI 

t 

ELTI0160 

* 

8H 

CHAIN 

,8H 

CONTCT 

y 8H 

VISPR 

y 8H 

DAUX1 1 

y 6H 

DAUXI2 

♦ 

ELTI0I7G 

♦ 

8H 

DAUX22 

y 6H 

DAUX3I 

,8H 

DAUX32 

,8H 

DAUX33 

♦ 8H 

FSMSOL 

t 

ELTI018G 

* 

8H 

PLELP 

» 8H 

BcLTRT 

y 8H 

SEUSEG 

y 8H 

AIRBAG 

y 8H 

RST  ART 

t 

E LT 10 190 

* 

8H 

SETUP2 

1 8H 

IMPULS 

y 8 H 

IMPLS2 

y 8H 

AIRBG3 

♦ EH 

DAUX55 

t 

ELTI020C 

♦ 

8H 

EJOINT 

»8H 

SPDAMP 

y 8H 

DAUX44 

y 8 H 

FLXSEG 

♦ 8H 

WINDY 

t 

ELTIG21C 

* 

8H 

HBELT 

t 8H 

y8H 

y 8H 

♦ 8h 

/ 

ELTI022G 

IF 

(N 

• GT.  1 ) 

GO  TO  20 

ELI  IG230 

IF 

(L 

•GT. 1 ) i 

GO  TC 

1 AG 

ELTI02A0 

E LTIC2  5C 
ELTIG260 
ELTIG27C 
E LT 102  80 
ELTI029C 
ELTIG30C 
E LTIC3IC 
ELTIG320 
E LTI033C 
ELTI034C 
ELTIG35G 
ELTI036G 
ELTI037C 
ELTIG38G 
ELTIG390 
ELTI040C 
ELTI041C 
ELTIG42C 
E LT 10430 
ELTI044C 
ELTI0450 
ELTIC46G 
ELTIC47C 
ELTIG48G 
ELTIG49C 
ELT 10500 
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30  MT OUT  = LTIME ( 1) 

NDIFF  = MTOUT-MT IN ( N ) 

MTINCN)  = -1 

IF  ( N D IFF . EQ.  0 ) GO  TO  32 
NT  ( N ) = NT (N)  ♦ NDIFF 
DO  31  1=1,40 

IF  (MTIN(I).NE.-l)  MT IN  Cl)  = MTIN(I)  ♦ NDIFF 

31  CONTINUE 

32  GO  TO  99 

SUBSEQUENT  CALLS  FROM  MAIN  PROGRAM,  PRINT  SUMMARY  TABLE. 

40  NTSUM  = LTIME(l) 

NT ( 1 ) = NTSUM  - MTIN ( 1) 

TIME  = FLOAT( NTSUM)/ 100 .C 
WRITE  (6,41)  TIME 

41  FORMAT ( f 1 ELAPSED  CPU  TIME  =*,F10.2,f  SECONDS*// 

* f SUB  CALLS  TIME  X '//) 

PC  SUM  = 0.0 
NTSUM  = 0 
DO  42  1=1 , NSUB 
J = IND(I) 

PC  = FLOAT (NT ( J ) )/TIME 
PC  SUM  = PC  SUM  ♦ PC 
NTSUM  = NTSUM  ♦ NT(J) 

42  WRITE  (6,43)  SUB ( J ) , NC ( J ), NT ( J ) , PC 

43  FORMAT (A10,2I 10,F10.2) 

WRITE  (6,44)  NTSUM, PCSUM 

44  FORMAT ( •OTOTAL • , 14X, I 1 0, F1C.2) 

99  RETURN 

END 


E LT 10510 
E LT 10  520 
E LT 10  530 
ELT 10640 
E LT 10550 
E LT 10560 
ELTIG570 
E LT  10580 
E LT 10590 
E LT 10600 
ELTIG61C 
ELTI0620 
ELTI063C 
ELT 10640 
E LT 10660 
E LT 10660 
E LT 10670 
E LT 10 680 
E LT 10690 
ELT 10 700 
ELTIi/710 
ELTI0720 
E LT 10730 
E LT 10740 
E LT 10  750 
ELTI076C 
E LT 10770 
E LT 10760 
ELT  10  790 
E LT 10800 
E LT 108 1C 
E LT 10820 
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DOUBLE  PRECISION  FUNCTION  EVALFO  (0,N,L)  EVAL0010 

REV  10  09/26/74EVALG020 

EVALUATE  FUNCTION  THAT  IS  DEFINED  AT  LOCATION  N OF  TAB  ARRAY  EVALG03G 

FOR  ABSCISSA  VALUE  D.  EVALUATES  DERIVATIVE  9 FUNCTION  OR  INTEGRAL  EVALCG40 


AS 


L EQUALS  0, 
TAB(N) 

TAB ( N+l ) - 
TAB ( N+2 ) - 
TAB ( N+3 ) - 
T AB ( N+4 ) - 
TAB ( N+5 ) - 


1,  OR  2.  TAB  ARRAY  IS  DEFINED  AS  FOLLOWS: 

DO  (DO  MUST  BE  NON-NEGATIVE) 

01  (FI  DEFINED  FOR  DO  < D < 01 ) 

D2  ( F2  DEFINED  FOR  01  < D < D2 ) 

(NOT  CURRENTLY  USED) 

(NOT  CURRENTLY  USED) 

START  OF  DEFINITION  OF  1ST  PART  OF  FUNCTION  (FI) 
WHICH  IS  FOLLOWED  BY  DEFINITION  OF  2ND  PART  OF  FUNCTION  (F2), 

IF  ANY • 

2ND  PART  OF  FUNCTION  EXISTS  IF  D2  IS  NON-ZERO. 

SIGN  OF  01  DETERMINES  FORM  OF  DEFINITION  FOR  1ST  PART  OF 

THE  FUNCTION. 

Dl  ZERO  INDICATES  THAT  FUNCTION  IS  CONSTANT  02  FOR  ALL  D « 


E VALG05C 
EVAL0C6G 
E VALGC70 
EVAL0O8O 
E VALGC9C 
EVAL01G0 
EVAL011G 
EVAL012G 
EVALG13G 
EVALG14C 
E VALC150 
EVAL016C 
E VALu 170 
EVALU18G 
EVAL019C 

Dl  POSITIVE  INDICATES  THAT  TAB(N+5)-TAB(N+10)  CONTAINS  EVALG20G 
AO , A1 , • • • A5 • THE  COEFFICIENTS  OF  A 5TH  ORDER  POLYNOMI A L. E VALC2 1C 

EVAL0220 

01  NEGATIVE  INDICATES  THAT  T AB ( N + 5 ) CONTAINS  NP  (REAL)  EVAL023G 

FOLLOWED  BY  0(1),  F(l),  0(2),  F(2)  ...»  O(NP),  F(NP)  EVAL024G 

EVAL0250 

WARNING-  TABULAR  FUNCTION  MUST  BE  DEFINED  FOR  WHOLE  RANGE v E VA LG26G 


THAT  IS»  FROM  DO  TO  01  INCLUSlVEfOR  Dl  TU  D2  INCLUSIVE. 


SIMILARLY,  THE  SIGN  OF  02  (IF  NON-ZERO)  DETERMINES  FORM  OF 
DEFINITION  OF  2ND  PART  UF  FUNCTION,  IF  ANY. 


IF 

IF 

IF 


DO 
1011 
ID2  | 


AND 

AND 


02=0 

D2#0 


FUNCTION 

FUNCTION 

FUNCTION 


= 0 


F 1 ( (Oil ) 
F2(  102 [ ) 


IMPLICIT  REAL*8(A-H,0-Z) 

COMMO  N/TAB  L ES/MXNTI , MXNT  B, MXTB 1 ,MXTB2 ,NT I ( 50 ) , NTAB (5  00 ) , TAB ( 2000 ) 
F = 0.0 
IOUTR  = 0 
DO  TAB(N) 

IF  (D.LT.DO)  GO  TO  40 

01  = TAB( N ♦ 1 ) 

02  = TAB(N+2) 

IF  (Ol.NE.O.O)  GO  TO  26 
IF  ( L — 1 ) 40,24,25 

24  F = 02 
GO  TO  40 

25  F=  ( D— DO) *02 


EVALC27G 
E VAL0280 
E VAL029C 
E VALG30G 
E VAL0310 
E VAL0320 
EVAL0330 
E VALG340 
EVALG35G 
E VAL0360 
EVALG37C 
EVALC38G 
E VAL0390 
E VAL0400 
EVALU410 
EVAL042G 
EVALC43G 
E VALu 440 
EVAL0450 
EVAL046C 
E VA  LC  470 
E VAL048C 
E VALG490 
EVAL0500 
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GO  TO  40 

COMPUTE  INDEX  OF  FI  DEFINITION 

26  NP  = N+5 

IF  (L.E0.2)  GD  TO  41 

DERIVATIVES  AND  FUNCTIONS  HERE,  INTEGRALS  HAVE  OTHER  LOGIC 

IF  (D.LT.DABS(DD)  GO  TO  31 
IF  (D2.NE.0.0)  GO  TO  32 

D .GE.lDll  , D2  = 0 

30  IF  (Dl.Lt.0.0)  GO  TD  33 

I0UTR.EQ.1  INDICATES  D BEYOND  RANGE.  DERIVATIVE  = 0. 
I0UTR.EQ.0  INDICATES  D.LE.|D1|.  COMPUTE  POLY  DERIVATIVE 

IF  ( D. GT .DABS ( D1 ) ) I0UTR  = 1 
X = D1 
GO  TO  37 

DO  < D < | Dll 

31  IF  (D1.LT.0.0)  GO  TO  35 
X = 0 

GO  TO  37 

D .GE.  t D 1 | , D2  NON-ZERO,  USE  F2 

32  MP  = 6 

COMPUTE  INDEX  OF  F2  DEFINITION 

IF  (Dl.LT.0.0)  MP  = 2.0  * TAB(NP)*1.0 
NP  = NP+MP 

IF  ( D • LT .DABS ( D2 ) ) GO  TO  34 
29  IF  (D2.LT. 0.0)  GO  TO  33 

I0UTR.EQ.1  INDICATES  D BEYOND  RANGE.  DERIVATIVE  = 0. 
IOUTR.EQ.C  INDICATES  D.LE.|D2|.  COMPUTE  POLY  DERIVATIVE 

IF  (D.GT.DABS(D2) ) IOUTR  = 1 

D .GE.  D2  (POSITIVE),  EVALUATE  F2  FOR  D2 

X = D2 
GD  TO  37 


EVAL0510 
E VA  LO  520 
E VAL0530 
BVALG54C 
EVAL0550 
E VAL0560 
EVAL0570 
E VA  LO  5 80 
EVALO590 
EVA  LC600 
EVAL061G 
EVALG62G 
EVAL0630 
EVALG64G 
E VAL0650 
EVA  LG66G 
EVA L067G 
E VAL0680 
EVAL0690 
EVAL0700 
E VALG71C 
EVA  L072C 
E VALG73G 
EVA  LC  740 
EVAL075G 
EVALG76G 
E VAL077G 
EVA  LG78G 
EVALG79G 
EVALG800 
EVAL08I0 
E VA  LC  820 
E VAL663G 
E VALG84G 
EVA  L08  50 
EVA LG86G 
E VALG87G 
E VAL088G 
E VAL089G 
E VALG900 
EVAL091G 
EVALG92G 
EVAL093G 
E VALG940 
E VALG950 
EVA  L096G 
E VAL0970 
EVAL0980 
EVALC99G 
E VAL1000 
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D EXCEEDS  TABULAR  DEFINITION,  SET  F = F(NP) 

IF  TABLE  DEFINITION  EXTENDS  BEYOND  RANGE,  USE  TABLE  VALUES 

33  MB  *=  TAB(NP) 

NB  = NP+MB+MB 

IF  (D  .LE.  TAB ( NB-I ) ) GO  TO  35 
IF  (L.EQ.l)  F=TAB ( NB ) 

GO  TO  40 

I D 1 | .LE.  D < | D2 | 

34  IF  (D2.LT.0.0)  GO  TO  35 
X = D 

GO  TO  37 

EVALUATE  F FROM  TABULAR  DEFINITION 

35  MB  = TAB(NP) 

K I = NP+3 

K2  = NP+MB+MB 
DO  36  K=KI,K2,2 
IF  (D.GT.TAB(K))  GO  TO  36 
IF  (L-I)  28,27,40 

EVALUATE  DERIVATIVE  FROM  TABLE 

28  F = (TAB(K  + l)-TAB(K-m/(TAB(K)-TAB<K-2n 
GO  TO  40 

EVALUATE  FUNCTION  FROM  TABLE 

27  R2  = TAB(K)-TAB(K-2) 

R1  = (D-TAB(K-2) )/R2 

R2  = (TAB(K)-D  )/R2 

F = R1*TAB (K+l )+R2*TAB(K-l) 

GO  TO  40 

36  CONTINUE 

IF  (L.EQ.l ) F = TAB ( K2 ) 

GO  TO  40 

37  IF  (IOUTR.EQ.l  .AND.  L.EQ.O  ) GO  TO  40 
IF  (L-l)  38,39,40 

EVALUATE  DERIVATIVE  OF  5TH  DEGREE  POLYNOMIAL 

38  F = TAB(NP+l)+X*(2.0*TAB(NP+2)+X*(3.0*TAB(NP+3)+X*(4.0*TAB(NP+4) 
♦ X*5.0*TAB(NP+5)) ) ) 

GO  TO  40 

tV ALU ATt  5TH  DEGREE  POLYNOMIAL 


EVAL10I0 
E VALI020 
EVAL1C30 
EVA  LI  040 
EVAL105C 
EVAL1060 
EVA  LI  070 
EVAL108G 
EVAL1090 
EVAL1100 
EVALI1IO 
EVAL1120 
EVAL1130 
EVAL1I40 
EVAL1I50 
EVA  LI  160 
EVAL1I70 
EVAL118G 
EVAL1190 
E VAL1200 
EVALI210 
EVAL1220 
EVAL1230 
E VAL1240 
EVAL1250 
EVAL1260 
EVAL1270 
EVA  LI 280 
EVAL1290 
EVAL1300 
EVALI31C 
EVAL132G 
£ VALI330 
EVAL134C 
E VAL1350 
EVAL136C 
EVAL1370 
EVAL1380 
EVAL1390 
EVAL140C 
EVAL1410 
t VAL1420 
EVAL1430 
EVAL144C 
♦ EVAL1450 
EVAL1460 
EVAL147C 
EVAL148C 
EVAL1490 
EVAL1500 
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39  F = TAB(NP)  ♦ X* ( TAB (NP+1 ) +X*  ( TAB ( NP+2 ) 

♦ +X*(TAB(NP+3)+X*(TAB(NP+4)+X*TAB(NP+5) ) ) ) ) 

GO  TO  4C 

L=2 : COMPUTE  INTEGRAL  OF  FUNCTION  FROM  DO  TO  D. 

41  IF  (D.EQ.DO)  GO  TO  40 
XO  = DO 
XI  = D 1 
DO  50  1=1*2 
IF  (XI)  43,49,42 


42  AO 

= 

T AB(  NP  ) 

A1 

= 

TAb(NP+l)/2.0 

A2 

= 

TAB(NP+2)/3.0 

A3 

s 

T AB  ( NP  *3  ) /4  .0 

A4 

s 

TA  b(  NP+4  ) /5 .0 

A5 

= 

TAB(NP+5 )/6.0 

NP 

= 

NP+6 

X = XO 

IF  (X.NE.O.O)  F=F-X* ( AO  + X* ( A 1 + X*  ( A2+X*( A3+X* ( A4+X* A5 ) ) ) ) ) 

X = DM  1 N1 ( D *X 1 ) 

IF  (X.NE.O.O)  F=F+X*( A0+X*(A1+X*( A2+X*( A3+X* < A4+X* A5 ) ) )) ) 

IF (D.LE.X1)  GO  TO  40 

IF( I .EQ.1.AND.D2.NE.0.0)  GO  TO  49 

NOTE  - NP  WAS  UPDATED  NP=NP+6  BEFORE  THIS*  READY  FOR  SECOND  PASS 

F = F ♦ (D-Xl )*(TAB(NP-6)+Xl*(TAB(NP-5)+Xl*(TAB(NP-4) 

* + X 1* (TAB ( NP-3) ♦Xl*(TAB(NP-2)+Xl*TAB(NP-l) )) ) ) ) 

GO  TO  40 

43  MB  = TAB(NP) 

K1  = NP  +3 

K2  = NP+MB+MB 
NP  = K2+1 

DL  = DM  IN  1 ( D,  DAB  S ( X 1 ) ) 

DU  44  K=K1 * K2  * 2 

IF  ( XO.GE • TAB ( K ) ) GO  TO  44 

21  = DMAX1 (X0*TAB(K-2 ) ) 

22  = DMIN1(DL,TAB(K) ) 

FYX  = T AB ( K-l ) *T  AB  ( K ) - TAB ( K+l ) *T Ab ( K-2 ) 

FY  = T AB( K + 1 ) - TAB ( K-l ) 

F = F + (FYX  ♦ 0.5*F Y*(  21+22  ))  *(22-21)/  ( TAB( K )-T AB ( K-2 ) ) 

IF  (22 .NE. DL)  GO  TO  44 

IF( I .EQ.l. AND.D2 .NE.O.O)  GO  TO  49 

IF ( 22 • EQ.  D)  GO  TO  40 

F = F +(D-22)*(FYX+22*FY)/  ( TAB ( K ) -T AB ( K-2 ) ) 

GO  TO  40 

44  CONTINUE 

49  XO  = DABS(Dl) 

50  XI  = D2 


EVA  LI  510 
EVAL1520 
E VAL1530 
EVAL1540 
EVAL1550 
EVAL1560 
EVAL1570 
EVAL1580 
E VAL1590 
EVAL1600 
EVAL1610 
EVAL1620 
EVAL1630 
EVAL1640 
E VAL 1650 
EVAL1660 
EVAL167C 
EVA  L168C 
EVAL1690 
EVAL1700 
EVAL1710 
EVAL1720 
EVAL1730 
EVAL1740 
E VAL1750 
EVAH760 
EVAL1770 
EVA  L1780 
EVAL1790 
EVAL18O0 
EVAL181G 
EVAL1820 
EVAL1S30 
E VAL 18 40 
EVAL1850 
EVAL186C 
EVAL1670 
EVAL1880 
EVAL1890 
E VAL  1900 
EVAL1910 
EVAL1920 
EVAL1930 
E VAL 1940 
EVAL1950 
E VAL1960 
EVAL1970 
EVA  LI 980 
EVAL1990 
EVAL2000 
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40  EVALED  « F 
RETURN 
END 


EVAL2010 
E VAL2020 
EVAL2030 
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SUBROUTINE  FINPUT  F 

REV  12  12/ 18/74F 

CONTROLS  CARD  INPUT  SPECIFYING  THE  ALLOWED  CONTACTS  OF  THE  CRASH  F 
VICTIM  BODY  SEGMENTS  WITH  VEHICLE  PANELS*  BELTS,  AIRBAGS  AND  OTHERF 


BODY  SEGMENTS  ALONG  WITH  THE  ASSOCIATED  FUNCTIONS  TO  BE  USED  FOR 
EACH  CONTACT. 

ALSO  SETS  UP  TABLES  TO  CONTROL 
EACH  FUNCTION  FOR  EACH  ALLOWED 


TIME  HISTORY 
CONTACT. 


INFORMATION  FOR 


IMPLICIT  REAL*8(A-H,0-Z) 

COMMON/LONTRL/NSEG,NJNT ,NS3,NJ3,NPL,NBLT  * NB AG * NVEH *NGR ND , NP RT ( 40 ) 
COMMON  /JB ARTZ/  MNPL ( 2C),MNBLT(  8),MNSEG(  22),MNBAG(  6), 

♦ MPL (3*5,20 ) ,MBLT(3,5, 8) ,MSEG ( 3 , 5 , 22 ) * MBAG ( 3 * 1 0, 6 ) * 

* NTPL( 5*20) ,NTBLT(5,8),NTSEG(5  *22) 

COMMON/TAB LES/MXNT I ,MXN TB, MXTB 1 ,MXTB2,NT I ( 50  ) ,NTAB ( 500  ) ,TAB ( 2CC0 ) 


COMMON/ TITLES/  DATE ( 3 ) , CLMLNT( 40 ) , VPSTTL ( 20 ) * BDYTT L ( 5 ) ,BLTTTL ( 5 , 8 ) F 


* *PLTTL<  5,20) *BAGTTL( 5,6), SEG(22) *J0INT( 21) 

* ,C  GS ( 2 1 ) , JS( 21 ) 

REAL  DATE, COME NT, VPSTTL , BD YTTL ,B LTTT L , PLTTL , B AGTT L , SEG , JOI NT 
L0GICAL+1  CGS , JS 

C0MM0N/CSTRNT/A13(3,3,24), A23( 3 , 3 , 24) , B 3 1 ( 3 , 3 , 24) , B32 ( 3,3,24) 

* fHHT(3,3,12),RKl(3»12 ),RK2< 3,12  ),QQ( 3,12) ,TQQ(3t 12) 

* ,RQQ(3,12) ,HQQ( 3,12) ,SUQ(12 ) ,CFQQ( 12) 

* ,NQ,KQ1U2)  ,KW2  (12),K0TYPE(  12) 

COMMON/DESCRP/  PHI ( 3 , 22 ) , W ( 2 2 ) , SR ( 3 ,42 ) , H A ( 3 , 42 ) , HB ( 3 , 42 ) 

* ,HT ( 3 , 3 ,42 ) , RPHI ( 3 , 22 ) , RW ( 22 ) , SPR ING( 5 , 63 ) 

* ,VISC(7,63),JNT( 21) v IPINC  21 ) ,MS,ISING(22) 

* ,IGLOB ( 21 ) , JOI NT F( 2 1 ) 

COMMON/CEULER/  I EULER (22  ) ,H I R( 3,3 , 21 ) , A NG ( 3 , 21 ) , ANGD ( 3 , 21 ) , 

* F E ( 3 , 2 1 ) ,TQE ( 3,31 ), CONST ( 3,21 ) 

COMMON/KAL  EPS/WTIME(30)  , IW IND ( 30 ) , MWSEG ( 5 , 22  ) 
C0MM0N/TEMPVS/JTITLE(5,51) , NF ( 5 ) , NS ( 3 ) , K T ITL E ( 31 ) 

REAL  BLANK  /•  #/ , JTI T Lfc , K TI TLE 


REAL  SURFC  E (2,3)/* 
MX  NT  I = 50 
J1  * MXTB 1 ♦ 1 


PL  < 


•ANE 


BE  f , • LT  SEG • , f M LNT  V 


INPUT  ALLOWED  CONTACTS  AND  FUNCTIONS  BY  REF.  NO. 

NT  = 1 

WRITE  (6,31) 

31  FORM AT ( *1  ALLOWED  CONTACTS  AND  ASSOCIATED  FUNCTIONS1) 
DO  61  1=1,4 

IJK  = 0 

GO  TO  (32,34,35,36) , I 

32  IF  (NPL.LE.O)  GO  TO  61 


INPUT  NO.  OF  SEGMENTS 
INPUT  CARD  F.l.A 


TU  CONTACT  EACH  PLANE. 


INPC01G 
IN PC C 20 
INP0C3O 
INPO04G 
IN  POO  50 
INPC06G 
INP0070 
INP0G8G 
INP0090 
INPC1C0 
INPOUG 
INP012C 
INP0130 
IN  PO 140 
INP0150 
IN  PO 160 
INP0170 
INPulBO 
IN  PO  190 
INP0200 
INP0210 
INP0220 
INP0230 
INP0240 
IN  PO  250 
IN  PO  260 
IN  PO  270 
INP0280 
IN  PC  2 90 
INP0300 
IN  PO  3 10 
INP0320 
INP0330 
IN  PO  340 
INP0350 
INP036C 
INP0370 
INPG380 
INP0390 
INP0400 
INPG41G 
INP0420 
IN  PO  430 
INP0440 
INP0450 
INP0460 
INP047C 
IN  PC  480 
INP0490 
IN  PO  500 
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READ  (5*33 ) ( MN PL ( J ) , J= 1, NPL ) 

33  FORMAT (1814) 

NJJ  = NPL 

GO  TO  37 

34  IF  (NBLT.LE.O)  GO  TO  61 

INPUT  NO*  OF  SEGMENTS  TO  CONTACT  EACH  BELT. 

INPUT  CARD  F.2.A 

READ  (5,33)  ( MNBLT ( J ) , J=1 ,NBLT) 

NJJ  = NBLT 
GO  TO  37 

35  IF  (NSLG.LE.O)  GO  TO  61 

INPUT  NO.  OF  SEGMENTS  TO  CONTACT  EACH  SEGMENT. 

INPUT  CARD  F.3.A 

READ  (5,33)  ( MNSEG ( J ) , J=1 ,N SE G) 

NJJ  = NSEG 
GO  TO  37 

36  IF  (NJNT.LE.O)  GO  TO  61 
INPUT  CARD  F.4.A 

SUPPLY  IGL OB( J ) = 1 FOR  EACH  GLOBALGRAPHI C JOINT  J=1,NJNT 

READ  (5,33)  ( IGLOB ( J ) , J =1 ,N JNT) 

NJJ  = N JNT 

START  OF  LOOP  TO  READ  CONTACTS  FOR  PLANES  (1=1),  BELTS  (1=2), 
SEGMENTS  (1=3)  AND  FUNCTIONS  FOR  GLOBALGR APHIC  JOINTS  (1=4). 

37  DO  60  J=1 , NJJ 

IF  (I .EG.l ) NK  = MNPL ( J ) 

IF  (I.EQ.2)  NK  = MNdLT(J) 

IF  (I.EQ.3)  NK  = MNSEG(J) 

IF  (I.EQ.4)  NK  = IGLOB ( J ) 

IF  (NK.LE.O)  GO  TO  60 
DO  59  K=1 , NK 

IF  (IJK.EQ.G)  WRITE  (6,38)  I 
3B  FORMAT(  •0« , 119X, •CARDS  F.SI1) 

IF  (IJK.EQ.G  .AND.  I.NE.4)  WRITE  (6,39)  SURFCE ( 1, I ) , SURFCE ( 2, I ) 

39  FORMAT ( '0* , 3X , 2A4, 8X , • S EGM ENT • ,2X, •FORCE  DEF LECTI ON • , 6X, • INERTIAL 
*$P  IKE  • , 10X  , 'R  FACTOR  • , 1 3X,  fG  FACTOR* ,10X,f FRICTION  COEF.M 
IF  ( IJK.EQ.G  .AND.  I.EQ.4)  WRITE  (6,40) 


40  FORMAT ( *0* , 5X, fJOINT  ( GLOB ALGR APHI C ) • ,2X, •TORQUE 


*ERRON 
IJK  = 


FORMULA', 10X,'R 
1 


FACTOR* ,13X, *G  FACT0Rf,10Xi 


DEFLECTION*, 6X, • 
•FRICTION  COEF. • 


INPUT  CONTACT  SURFACE  NO.,  SEGMENT  NO., 
INPUT  CARD  F.(I).(K) 


AND  FUNCTION  NOS  < 


F IN  PO  510 
F INPG520 
FINP0530 
FINP0540 
FINP0550 
FINP0560 
F INP0570 
FINPG58G 
FINP0590 
FINP0600 
FINP0610 
FINP0620 
FINP0630 
FINP064C 
F INP065C 
FINPU660 
F INP0670 
F INPG680 
F IN  PO  690 
FINP0700 
FINP0710 
FINPU720 
F INP0730 
FINP0740 
F IN  PC  750 
FINPG760 
FINP0770 
FINPG780 
FINP0790 
FINPC800 
F INPG810 
FINP0820 
F INP0830 
FINP0840 
F INPG850 
F IN  PG  860 
F INP0870 
F INPC68G 
FINP0890 
FINP0900 
F INPG910 
FINPG920 
FINPG930 
F INP094G 
HFINP0950 
) F IN  PO  960 
F INP0970 
FINP098G 
FINPC99G 
FINPICOG 


92 
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F INP101G 

READ  (5,33)  NJ,NS,NF 

F1NP102G 

WRITE  (6,41)  NJ,NS,NF 

F IN  PI  030 

41 

FORMAT ( *0» ,17, »-• ,13,111,*-' 

,13,18,4121) 

FINP1G4G 

IF  (NJ.NE.J)  WRITE  (6,42) 

FINP1G5G 

42 

FORMAT ( * F INPUT  INPUT  ERROR. 

PROGRAM 

TERMINATED. • ) 

FINP1C6C 

IF  (NJ.NE.J)  STOP 

FINP1U70 

NLT  = 1 

FINP1C8G 

DO  43  JJ  = 1,31 

F INP1090 

43 

KTITLfc(JJ)  = BLANK 

FINP11G0 

GO  TO  (44,46,48,49) , I 

FINPU1G 
F IN  P 1 120 

PLACE  SEGMENT  NO.  AND  INDEX 

TO  NTAB 

ARRAY 

INTO  M-  AND  NT- 

ARRAYS.  FINP1130 

FINP114G 

44 

MPL( 1 , K , J ) = NS ( 1 ) 

F IN  Pi 1 50 

MPL( 2 , K , J ) = NS ( 2 ) 

FINP1160 

MPL ( 3 ,K  ,J ) = NS ( 3 ) 

FINP117G 

NT  PL ( K , J ) = NT 

FINP118G 

DO  45  JJ  = 1,5 

F1NP1 19l 

45 

KTITLE(JJ)  = PLTTL  (JJ,J) 

FINP12GG 

GO  TO  50 

FINP1210 

46 

MBLT(1,K,J)  = NS ( 1 ) 

F1NP122G 

MB  LT  ( 2 , K,  J ) = NS  ( 2 ) 

F 1NP123G 

MBLT ( 3 ,K, J ) = NS ( 3 ) 

F1NP124C 

NTBLT ( K ,J ) = NT 

FINP125G 

DO  47  JJ  = 1,5 

F IN  P 1260 

47 

KTITLE(JJ)  = BLTTTL  (JJ,J) 

FINP127C 

F1NP128G 

SET  UP  TWO  TABLES  FOR  FULL  BELT  FRICTION 

FINP129G 

FINP13C0 

IF  (NF(5).NE.O)  NLT  = 2 

F IN  PI  3 10 

GO  TO  50 

F IN  P 1 320 

48 

MS  EG  ( 1 f K?  J ) = NS  ( 1 ) 

F1NP133G 

MS  EG ( 2 t J ) = NS ( 2 ) 

FINP134C 

MS  EG( 3 « Kv  J ) = NS ( 3 ) 

FINP1350 

NT  SEG ( K » J ) = NT 

F1NP1360 

KTITLE  (3)  = SEG(J) 

FINP1370 

GO  TU  50 

F IN  PI  380 
FINP1390 

NOTE:  GLOBALGRAPHIC  JOINT 

WILL  SAVE  NT 

IN  IGLOB  ARRAY 

FINP14G0 

FINP1410 

49 

IGLOB(J)  = NT 

F IN  P 1420 

KT ITL  E < 2)  = JOINT(J) 

FINP1430 
F IN  PI 440 

SET  UP  POINTERS  TO  TAB  ARRAY 

IN  NTAB 

ARRAY 

• 

FINP145C 
F IN  P 1460 

50 

NFJ  = NS( 2 ) 

FINP147C 

IF  ( NFJ  .GT • 0)  KTITLE ( 6 ) = SEG(NFJ) 

FINPI48C 

DO  52  JJ  = 1,5 

F IN  P 1490 

IF  (NF(JJ) • LE • 0 ) GO  TO  52 

F IN  PI  500 
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NFJ  = NF(JJ) 

FINP1510 

DO  51  KK  = It  5 

F IN  Pi  520 

KJ  = 5* JJ+KK+ 1 

FINP1530 

51 

KTITLE(KJ)  = JTITLE(KK,NFJ) 

FINP1540 

52 

CONTINUE 

FINP155C 

WRITE  ( 6f 53 ) KTITLE 

FINP156G 

53 

FJRMAT(lX,5A4,lX,A4f 5( 1X,5A4)  ) 

F INP1570 

DO  58  NL  = IfNLT 

FINP1580 

NTAB(NT)  = J1 

FINP1590 

NT  = NT  + 1 

FINP1600 

DO  56  L=1 » 5 

FINP1610 

NX  = NF (L ) 

FINP162C 

NTAB(N7)  = 0 

F IN  PI 630 

IF  ( NX • EQ. G ) GO  TO  55 

F IN  Pi  640 

NTAB(NT)  = NT  I (NX ) 

F INP165G 

IF  (NTl(NX).NE.G)  GO  TO  56 

F IN  P 1 660 

WR  I T E ( 6 » 54  ) NX 

FINP167C 

54 

FORMAT  (fC  FUNCTION  N0.*,I4tf  HAS  NOT  BEEN  DEFINED.  PROGRAM 

TER  MI F IN PI 68 C 

♦NATED. * ) 

FINP1690 

STOP 

FINP1700 

55 

IP  (L.NE.l)  GO  TO  56 

FINP1710 
F IN  PI  720 

IF  FORCE  DEFLECTION  FUNCTION  NO.  IS  ZERO, 

FINP1730 

SET  UP  FOR  ROLLING  CONSTRAINT 

F IN  PI  740 
FINP175C 

NQ  = NQ+1 

FINP1760 

NTAB(NT)  = -NO 

F IN  PI  770 

KQTYPE(NQ)  = -4 

F IN  PI 78 C 

KOHNQ)  = NS(  2 ) 

FINP179G 

KQ2(NQ)  = NS( 1 ) 

F INPlbOO 

IF  (I.NE.3)  GO  TO  56 

F INP1810 

KOHNQ)  = J 

F INP1820 

KQ2 ( NO  ) = NS( 2 ) 

F IN  PI  830 

56 

NT  = NT+1 

FINP1640 
F IN  PI  850 

INITIALIZE  TAB  ARRAY  TO  ZERO  EXCEPT  FOR  DMAX , DINER,  FDMAX. 

FINP186G 

FINP1870 

J2  = Jl  + 19 

F IN  Pi  880 

DO  57  JJ=J1,J2 

F INP 1896 

57 

TAB(JJ)  = 0.0 

F IN  PI 900 

NX  = NT  AB ( NT— 5 ) 

FINP1910 

IF  (NX.LT.O)  GO  TO  5B 

FINP1920 

TAB ( J I +8 ) = DABS ( TAB (NX  + I) ) 

FINP1930 

IF  (TAB(NX+2> .NE.O.Q)  TABU1+8)  = DABS(  T AB(NX+2  ) ) 

FINP1940 

TAB ( J I +10 ) = EVALFD ( TAB ( JI +8 ) »NX  » 1 ) 

FINP1950 

NX  = NTAB( NT-4) 

FINP1960 

IF  (NX.LE.O)  60  TO  5B 

FINP1970 

TAB ( J I ♦9)  = DABS ( TAB (NX  + 1) ) 

FINP198C 

IF  (TAB(NX+2) .NE.O.C)  TAB(Jl+9>  = DABS ( TAB ( NX+2 ) ) 

F INP1990 

58 

Jl  = J2+1 

F INP2000 
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59 

60 
61 


62 


CONTINUE 
CONTINUE 
CONTINUE 
MXNT8  = NT— I 
MXTB2  = Jl-1 

IF  (MXTB2.GT. 2000)  WRITE  (6,62)  MXTB2 

FORMAT ( *0  ERROR  IN  SUBROUTINE  FINPUT,  SIZE  OF  TAB  ARRAY  =‘,18// 

♦ • PROGRAM  TERMINATED1) 

IF  (MXTB2.GT.2000)  STOP 

INPUT  CARD  F.5  - JOINT  FUNCTIONS  TO  BE  USED. 

IF  (NJNT.LE.O)  GO  TO  81 

READ  (5,33)  (JOINTF(J) » J=I ,NJNT) 

IJK  = 0 

DO  8 C J=1,NJNT 

IF  ( JOINTF( J) .EQ.O)  GO  TO  80 

IF  (IJK. EQ.O)  WRITE  (6,77) 

77  FORMA!  ( *1 • *119X, 'CARD  F.5*/ 

♦ 1 THE  FOLLOWING  JOINT  RESTORING  FORCE  FUNCTIONS  AS  DEFINED 
*ON  CARDS  E • 7 WILL  bE  US E D. 1 //4X ,» JOINT •, IOX ,• FUNCT ION •// ) 

JF  = JOINT  F ( J ) 

IJK  = 1 

WRITE  (6,78)  J,JOINT(J) , JF , ( JT ITLE ( I , JF ) ,1=1,5) 

FORMAT (16, '-’,A4«II0t ,5A4  ) 

IF  (NTI  (JF)  .EQ.O)  WRITE  (6,42) 

IF  (NTI(JF) .EQ.O)  STOP 
CONTINUE 


78 


80 


INPUT  CONTACT  SEGMENTS  FOR  AIRBAG,  IF  ANY. 


81  IF  (NBAG.LE.O)  GO  TO  69 
IJK  = 0 

DO  68  J=1,NBAG 
INPUT  CARD  F • 6 • ( J ) 

READ  (5,63)  K , NK  , ( M8 AG ( 2 , 1 , J ) , MB AG ( 3 , I , J ) , 1= I , NK ) 

63  FORMAT( 214 ,2012) 

MNBAG(J)  = NK 

IF  (NK.EQ.O)  GO  TO  68 
IF  (IJK. EQ.O)  WRITE  (6,64) 

64  FORMA T ( ////5X, •AIRBAG1, 4X, *VS. 1 , 4X , • SEGM ENTS • , 90X , 'CARDS 
IF  (K.NE.J)  WRITE  (6,42) 

IF  (K.NE.J)  STOP 

WRITE  (6,65)  J,(MBAG(2, I , J ) , MB  AG ( 3 , I , J ) ,1-1, NK) 

65  FORMAT ( *0  NO . • , I 2, 1 2X, 10 ( 1 3, •- • , 13 ) ) 

DO  66  I*=1,NK 

K = M b AG( 2 , 1 , J ) 

66  KTITLE(I)  = SEG(K) 


F . 6 • ) 


F INP20IC 
FINP2020 
FINP2  030 
F INP2040 
FINP2G5G 
FINP2060 
FINP207G 
F INP2C8C 
F INP209C 
FINP210G 
FINP2I10 
FINP2120 
F INP2130 
FINP2I40 
FINP2150 
FINP216G 
F INP217U 
FINP2180 
FINP2I9C 
FINP2200 
FINP22I0 
F INP2220 
F INP2230 
FINP2240 
FINP225C 
F INP2260 
FINP227C 
F INP2280 
FINP2290 
F INP2300 
FINP2310 
F INP2320 
FINP2330 
FINP2340 
F INP235G 
FINP2360 
F INP2370 
FINP2380 
FINP239G 
F INP2400 
F INP241C 
F IN  P2420 
FINP2430 
F INP2440 
FINP2450 
FINP246G 
F INP2470 
FINP2480 
FINP249w 
FINP2500 
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WRITE  (6,67)  ( BAGTTL ( I , J ) , 1= 1, 6) , ( KTITLE ( I ) , 1=1 ,NK ) 

67  FORM  AT ( IX , 5A4  , 10 ( 3X , A4 ) ) 

68  CONTINUE 

INPUT  CARDS  F.7.A-F.7.B  FOR  SUBROUTINE  WINDY. 

69  READ  (5,33)  ( MWSEG ( 1 , J ) ,J  = 1 ,NSEG ) 

IPAGE  = 0 

DO  73  J=1 ,NSEG 
IWIND  ( J ) = 0 
WTIME(J)  = 0.0 

IF  ( MWSEG ( 1 , J ) • EQ.O ) GO  TO  73 
IF  (IPAGE. EU.O)  WRITE  (6,70) 

70  FORMAT  ( *1  SEGMENT  WIND  FORCES* ,99X,fCARDS  F.7*// 

♦ • SEGMENT-ELLIPSOID  SEGMENT-PLANE*, 

♦ 17X , * W IND  FORCE  FUNCTION*) 

IPAGE  = I 

READ  (5,33)  ( MWSEG ( I , J ) ,1 =1 ,5 ) 

WRITE  (6,71)  (MWSEG( I,J ) ,1=1,5 ) 

71  FORMAT( *0* ,17, • -*,13,114,*  -*,13,130) 

IF  ( MWSEG ( 1 , J ) .NE.J)  WRITE  (6,42) 

IF  ( MWSEG ( 1 , J ).NE.J ) STOP 
M3  = MWSEG ( 3, J ) 

M4  = MWSEG ( 4, J ) 

M5  = MWSEG ( 5 , J ) 

WRITE  (6,72)  SEG(J)«SEG(M3), (PLTTL(I,M4) ,1=1,5) 

♦ ,( JTITLE( I,M5> ,1=1,5) 

72  FORMAT (5X,A4, 15X,A4, , 5A4, 2X , 5A4 ) 

73  CONTINUE 
RETURN 
END 


FINP2510 
F INP2520 
FINP253G 
FINP2540 
F INP2550 
FINP2560 
FINP2570 
F INP2580 
F INP259C 
FINP2600 
F INP261G 
FINP2620 
FINP2630 
F INP2640 
F INP2650 
FINP2660 
F INP267G 
F INP268G 
FINP2690 
F INP2700 
FINP271G 
F INP2720 
FINP2730 
FINP2740 
F INP2750 
F INP2760 
F INP277C 
FINP2780 
F INP279G 
F INP2800 
FINP2810 


96 


SUBROUTINE  FLXSEG 

REV  12 

IMPLICIT  REAL*8( A-H,0-Z) 

C0MM0N/SGMNTS/D(3,3 ,22 ) , WMEG ( 3 , 22 ) , WMEGD ( 3 , 22 > , U1 ( 3, 22  ) ,U2(3,22) 
* ,SEGLP(3,22) « S EGLV ( 3 » 22 ) ,SEGLA (3,22 ) ,NSYM(22) 

COMMON/FLXBLE/  HF ( 4 , 12, 8 ) , B42 ( 3 , 3 , 24) , V4 ( 3, 8 ) , NFLEX ( 3 , 8 ) , NFLX 
COMMON/CNSNTS/  PI,  RADI  AN, G, TH IRQ , EPS1 , E PS4 , EPS6, E PS8 , 


F LXSOOIO 
I0/25/74F  LX SO 020 
FLXSC030 
FLXS0040 
FLXS005C 
FLXS0060 
FLXSC07C 


EPS12,EPSI5,EPS20,EPS24,UNITLtUNITM,UNITT,GRAVTY(3)FLXSu080 


II 


12 


13 


COMM ON /TEMP VS/  TT(3,3),  THN ( 4) , CN1(3,3),  CN(3,3),  WNM1(3), 

► THND ( 4) , PT D ( 3 ) , WCSN(3),  RHSN(3),  RH S 1 ( 3 ) , 

► RHS2 ( 3) , GF ( 3 , 4 ) , GC(3,3),  CGC(3,3),  TH A( 3 ) , 

► THAD ( 3 ) , THADEG( 3 ) , DN2NI(3,3),  RMG ( 3 ) 

IF  (NFLX.EQ.G)  GO  TO  99 

CALL  ELTIM  E ( 1 , 34 ) 

IF  X = 1 

N 1 = NFLEX  ( I,  I FX  ) 

N3  = NFLEX ( 3, I FX ) 

CALL  D0TT(D(1,1,N3),D(1, 1,N1 ),TT,3,3,3) 

THN(l)  = DATAN2 (TT(I,2)tTT(l,I)) 

THN ( 2 ) - -DARS IN ( TT ( 1 ,3 ) ) 

THN ( 3 ) = DATAN2 (TT( 2,3 ) ,TT(3,3) ) 

THN ( 4 ) = 1.0 

CT 22  = 1.0— TT ( 1 » 3 )**2 

CT2  = DSQRT( CT22 ) 

ST  2 = — TT  (1,3) 

CT I = TT ( I, I )/CT2 

STI  = TT(1,2)/CT2 

CNl(ltl)  - -TT ( 1 , 1 )*TT( I,3)/CT22 

CN I ( 1 , 2 ) = -TT(1,2)*TT( 1,3)/CT22 

CN 1(1,3)  = 1.0 

CN 1 ( 2 , 1 ) = -STI 

CN 1 ( 2 , 2 ) = CT 1 

CN 1(2,3)  = 0.0 

CN 1 ( 3 , 1 ) = TT (1,1) /CT2  2 

CN 1 ( 3 , 2 ) = TT ( 1 , 2 ) /CT22 

CN 1(3,3)  = 0.0 

CALL  DOT ( TT  ,WM  EG(  1, N3 > t WMU,  3,  1 « 3 ) 

DO  12  1=1,3 

WNMKI)  = WNMKI)  - WMEG(I,N1) 

CALL  MAT (CN 1, WNM 1 , THND , 3 ,3 , 1 ,3 ,3 , 3 ) 

THND( 4 ) = 0.0 

CALL  CROSS(WMEG( 1 ,N 1 ) , WNM1 , WCSN ) 

RHSN(l)  = ( ( -THND ( 1 )*ST 1*ST2  ♦ THND ( 2 ) ♦CT 1/CT2 )*WNM 1 ( 1 ) 

► ♦(  THND ( 1 ) *CT 1*ST2  ♦ THND ( 2 ) ♦ST1/CT2 )*WNM1 ( 2 ) )/CT2 

RHSN ( 2 ) = — THND ( 1 ) * (CT 1 *WNM 1 ( 1 ) ♦ ST1*WNM1(2)) 

RH  SN ( 3 ) = ( ( -THND ( 1 ) *ST 1 ♦ THND ( 2 ) *CT 1*ST2/CT2 )* WNM 1 ( 1 ) 

► ♦(  THND ( 1 )*CT 1 ♦ THND (2)*ST1*ST2/CT2)*WNM1( 2)  )/CT2 
N2  = NFLEX ( 2 , I FX ) 

M = 0 

DO  15  1=1,3 


FLXSG090 
FLXS0100 
FLXSC110 
FLXS0120 
FLXSG13G 
F LX  SO  140 
FLXS0150 
FLXS0160 
FLXSo 170 
FLXS0180 
F LXS019G 
FLXS0200 
FLXS0210 
FLXS0220 
F LXS0230 
FLXS02  40 
FLXSw250 
FLXS0260 
FLXS02  70 
FLXS0280 
FLXS0290 
FLXS030C 
FLXS0310 
FLXS0320 
FLXS0330 
FLXS0340 
FLXS0350 
F LXSG36G 
FLXS0370 
FLXS038U 
FLXS0390 
FLXS0400 
FLXS0410 
FLXSC420 
F LXSC43C 
FLXS0440 
FLXS0450 
FLXS046C 
FLXS0470 
FLXS0480 
FLXS0490 
FLXS0500 
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14 

15 


16 

17 


20 


DO  14  J=1 1 4 
JM  = J + M 
GF ( I f J ) = 0.0 
DO  14  K=l,4 

GF ( 1 f J ) = GF ( I f J ) ♦ HF  ( K » JM  » I FX ) *THN ( K ) 

M = M +4 

DO  17  1 = 1 » 3 

THA  ( I ) =0.0 

TH  AD  ( I ) = 0.0 

DO  16  J=1 » 4 


THA  (I)  = THA  (I)  ♦ GF  ( I f J ) *THN  (J) 

THAD(I)  = THAD(I)  ♦ GF(  I , J ) *ThND ( J ) 

THA  (I  ) = 0.5* THA ( I ) 

THADEG  ( I ) = THA(  D/RADIAN 
CALL  DRCYPR(DN2NlfTHADEG,3,2,l ) 

CALL  MAT(DN2Nl,D(lf ltNl ) »D  d , 1 ,N2  ) *3,3, 3 , 3 , 3 ,3  ) 

CSC  = DCOS ( TH A ( 2 ) ) 

CSS  = DSIN ( THA ( 2 ) ) 

CN( li  1)  = 0.0 

CN ( 2 v 1 ) = 0.0 

CN ( 3 # 1 ) = 1.0 

CN  ( 1 1 2 ) = HDSIN(THAd)  ) 

CN ( 2 f 2 ) = DCOS ( THA ( 1 ) ) 

CN ( 3 y 2 ) = O.C 

CN ( 1 9 3 ) = CSC*CN(2#2) 

CN ( 2 9 3 ) = — CSC*CN  ( 1 9 2) 

CN  ( 3 ♦ 3 ) = -CSS 

CALL  M AT ( GF  9 CNlf  GC,  3t393f393f3) 

CALL  MAT( CN ♦ GC,  CGCt  3,3,3939393) 

CALL  DOT  (D(lfltNl) ,CGC , B42 d , 1 , 3* IFX-2 ) , 3 , 3 , 3 ) 

CALL  DOTT ( B42 d f 1 t3* IFX-2) tTTf B42 (1 f 1 t3*IFX ) ,3,3f3 ) 
DO  20  1=1 9 3 
DO  20  J=1 9 3 

B42(I ,J,3*IFX-2)  = B42( I,J,3*lFX-2)  - D(J,I,N1) 
B42d  ,J,3*IFX~1)  = D ( J 9 1 9N2 ) 

B42( I , J,3*IFX  ) = -B42( I, J,3*IFX) 


COMPUTE  V4 


CALL  MAT(CGC9WNMl,RHSl  9 3 93  9 l93,3f  3) 

DO  21  1=1 9 3 

21  RMG  ( I ) = RHSKI)  ♦ WMEG(I,N1) 

CALL  MAT(DN2Nlf  RMG  9 WM  EG ( lf N2 ) 9 3 9 3 9 1 9 3f 3 9 3 ) 

CALL  CROS S(WMEG(lfNl) 9RHSI9RHS2) 

CALL  MAT(CGCf WCSN,RHSl,3,3fl 93f3,3) 

DO  25  1=1,3 

25  RHSl(l)  = RHS2  ( I ) - RHSKI) 

CALL  MAT(GC,WNM1,RHS29  3,3,  1,3, 3,3) 

RHSKI)  = RHSKI)  - THAD(1)*(CN(2,2)*RHS2(2)-CNU,2)*CSC*RHS2(3)  ) 
♦ - THAD(2)*CN(2,2)*CSS*RHS2(3) 


FLXS0510 
FLXSG52C 
FLXS053C 
FLXS0540 
FLXS0550 
FLXS056C 
F LX  SO  570 
FLXS058G 
F LX  SO  590 
F LXS0600 
FLXS0610 
FLXS0620 
FLXSG630 
FLXS0640 
FLXSO660 
FLXS0660 
FLXS067C 
FLXSG68G 
F LXSG690 
F LXS0700 
FLXS071G 
F LXS0720 
F LXS0730 
F LXS074G 
FLXSG730 
FLXS0760 
FLXS0770 
F LX SC 780 
FLXS079G 
F LX  SC  800 
F LX  SOB  1C 
FLXS0820 
FLXS0830 
F LX  SC 840 
FLXS0B50 
FLXS0860 
FLXS087C 
FLXSC880 
FLXS0890 
F LXSC90C 
FLXS0910 
FLXS092U 
F LX  SC  930 
FLXS094C 
F LX  Si>950 
F LXSC96G 
FLXS0970 
F LXSG980 
FLXSG99C 
F LX  SI COG 
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RHS 1 ( 2 ) = RHSI (2 ) ♦ THAD <1 )* (CN ( 1 , 2 ) *RHS 2 ( 2 ) +CN (2 » 2 ) *C SC*RHS2 ( 3 ) ) FLXS1G10 


* ♦ THAD(2)*CN(1»2 )*CSS*RHS  2 ( 3 ) 

F LXS1C20 

RHS 1 ( 3 ) = RHS 1(3)  - THAD(2)*CSC*RHS2(3) 

FLXS1030 

CALL  MaT(GF,  RHSN,  RHS2  , 3, 3,1,3, 3,3) 

FLXS1G4G 

M = 1 

FLXS1050 

DO  3C  1=1,3 

FLXS1D60 

CALL  MAT(HF(1,M,1FX),  THNO , PTD,  3, 3, 1,4, 3, 3) 

FLXS107C 

RHS2 ( I ) = RHS 2(1)  ♦ XDY ( PTD, CN 1 , WNM1 ) 

FLXS108C 

30 

M = M+4 

F LXS1090 

CALL  HAT (CN , RHS2 , PTD,  3,3, 1,3, 3, 3) 

FLXS1100 

DO  35  1=1,3 

FLXS111C 

35 

RHS 1 ( I ) = RHSI ( I ) ♦ PTD ( I ) 

FLXS1120 

CALL  DOT(D( 1, 1 , N 1 ) , RHS  1 , V4  ( 1 , I FX  ) , 3 , 1,  3 ) 

F LX  SI 1 30 

IF  ( IFX.EO.NFLX)  GO  TO  98 

F LX SI 140 

I FX  = IFX+l 

F LX SI  15  0 

IF  (NFLEX( 1,IFX) .EQ.N1  .AND.  NFLEX(3,IFX).EU.N3)  GO  TO  13 

FLXS116C 

GO  TO  11 

F LX SI 170 

98 

CALL  EL  TIM  E ( 2 , 34  ) 

F LX  SI  180 

99 

RETURN 

FLXS119C 

END 

FLXS1200 

99 
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DOUBLE  PRECISION  FUNCTION  FNTERP ( THETA , PH  I , NT ) 


REV 


F NT  ECO  1C 
12  12/06/74FNTE0020 


COMPUTES  THE  RESTORING  TORQUE  OF  A JOINT  AS 
FLEXURE  ANGLE  (THETA)  AND  THE  AZIMUTH  ANGLE 
FUNCTION  NO.  NT 


A FUNCTION  OF  THE 
(PHI)  AS  DEFINED  BY 


ASSUMES  C < THETA  < PI 
-PI  < PHI  < PI 

DATA  IN  TAB  ARRAY  CONTAINS  NTHETA, NPHI  FOLLOWED  BY 
TWO  DIMENSIONAL  ARRAY  OF  FUNCTIONAL  VALUES  (NTHETA  > C) 
OR  POLYNOMIAL  COEFFICIENTS  (NTHETA  < 0)  FOR  EQUALLY 
SPACED  VALUES  OF  PHI. 

THETA ( I ) = ( 1-1) *PI/(NTHETA-I ) FOR  I -1 *N THETA 
PHI ( J ) = -PI  ♦ ( J-l )*2*PI/NPHI  FOR  J-l *NPHI 
F ( THET A*  PI ) * F ( THETA  ,-PI ) 

SUBROUTINE  EVALUATES  GI (THETA)  = F ( THET A , PH I ( J ) ) 

G2 ( THETA ) = F(THETA,PHI (J*l) ) 

FOR  PHI ( J ) < PHI  < PHI ( J+l ) 

BY  LINEAR  INTERPOLATION  OR  POLYNOMIAL  EVALUATION  AND  THEN  LINEAR 
INTERPOLATES  BETWEEN  GI  AND  G2  TO  OBTAIN  F ( THET A, PHI ) . 

IF  F < 0»  F IS  SET  TO  ZERO,  THEREFORE  A DEAD  BAND  IS  OBTAINED 
BY  NEGATIVE  VALUES  IN  THE  TABLE. 


FNTEGG3C 
FNTEO04C 
F NTEG050 
FNTEC06C 
FNTE0070 
FNTEuOBG 
FNTEG090 
FNTE010C 
FNTEOllO 
FNTEG12C 
FNTE0130 
FNTEG14G 
FNTEC15G 
FNTE0160 
FNTEG17G 
FNTE016C 
FNTEG190 
FNT EG  200 
FNTE021G 
FNTEG22G 
FNTEG230 
FNT  EG  240 
F NT  E02  50 
FNTEG26G 
FNTEG27C 


IMPLICIT  REALMS  (A-H,0-Z) 

COMMON/CNSNTS/  P I ,RADI AN ,G, THI RD, E PS1 , EPS4,E PS6,EPS8 , 

♦ E PS 12, EPS  15 ,E PS 20, E PS24, UNIT L ,UN ITM ,UN I TT , GR AVT Y ( 3 ) FNT  E0280 

COMMON/TAB LES/MXNT I ,MXNT B, MXTB 1 ,MXTB2  , NT 1( 50 ) ,NTAB(5G0 ), TAB (2000)  FNT E029G 


I ERROR  *=  0 
IF  (PH1.LT.-PI) 

IF  (PHI.GT.  PI ) 

IF  (THETA. LT. 0.0) 
IF  (THETA. GT. PI  ) 
IF  ( 1 ERROR • NE. 0 ) 


I ERROR 
I ERROR 
I ERROR 
I ERROR 


1 

2 

3 

4 


WRITE  (6,11)  1ERR0R, THETA, PHI, NT 


FNTE030G 
FNT  EG  3 10 
FNTEG32G 
FNT  EG  330 
FNT EG  340 
FNTEG35G 


11  FORMAT(*0  IMPROPER  ARGUMENTS  TO  FUNCTION  FNTERP.  ERROR  CODE  =* , I4/FNTE036G 


* PHI  =f*G25.15,*  NT  =f,l6) 


► *0  THETA  *■ ,G25. 15, 

IF  (IERROfc.NE.O)  STOP 
NF  = NT  1 (NT ) ♦ 5 
NTHETA  * TAB(NF) 

NPH1  * T AB( NF+ 1 ) 


DETERMINE  INDEX  AND  INTERPOLATION  PARAMETERS  FOR  PHI. 

XNP  * (PHI+PI )/(2.0*PI)*TAB(NF^l) 

NP1  = XNP 
NP2  « NP1+1 

IF  (NP2.GE.NPHI ) NP2  = 0 
RP2  = XNP  - DFLOAT (NP1 ) 

RP1  s 1.0  - RP 2 


FNTE0370 

FNTEG380 

FNTEG390 

FNTEG40C 

FNTE0410 

FNTE042G 

FNTEG430 

FNTEG440 

FNTE0450 

FNTE0460 

FNTE0470 

FNTE048G 

FNTE049C 

FNTE0500 


100 
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NTH  = 1 ABS  ( NTHET  A ) 

FNTE051C 

IP1  = NF+1+NP1*NTH 

FNTEC520 

IP2  = NF+1+NP2*NTH 

FNTE0330 

FNTE0540 

DETERMINE  INDEX  AND  INTERPOLATION  PARAMETERS  FOR  THETA. 

FNTE0350 

FNTE0560 

IF  (NTHETA.LT. 0)  GO  TO  20 

FNTEG370 

XNT  = THETA/PI*(TAB(NF)-1.0) 

FNTE0580 

NT  1 = XNT 

FNTE0590 

RT2  = XNT  - DFLOAT(Nll) 

FNTE0600 

RT1  = i#0  - RT2 

FNTE0610 

IT  1 = IP1  ♦ NT  1 

FNTEG620 

IT 2 = IP2  ♦ NT  1 

FNTE063C 

G1  = RT1*T  AB ( IT  1 + 1 ) ♦ RT2^T  AB ( IT1  + 2 ) 

FNTE0640 

G2  = R11*TAB( IT2+1)  ♦ RT2*T AB ( I T2 + 2 ) 

FNTE0650 

GO  TO  23 

FNTE0660 

FNTE0670 

COMPUTE  FOR  POLYNOMIALS  IN  THETA  FOR  FIXED  PHI. 

FNTE0680 

FNTEG69G 

20 

NPOLY  = —NTHET  A— 1 

FNTE0700 

IT  I = IP1  ♦ NPOLY  ♦ 2 

FNTE071G 

IT2  - 1P2  ♦ NPOLY  ♦ 2 

FNTE0720 

THETA1  = THETA  - TAB(IPin) 

FNTE0730 

THETA2  = THETA  - TAB(IP2+1) 

FNTE074G 

G1  = 0.0 

FNTE0750 

G2  = 0.0 

FNTE076C 

DO  21  I =1 1 NPOLY 

FNTE0770 

IT  1 - ITI-I 

FNTE078C 

IT2  = IT2-1 

FNTE0790 

GI  - THETA1*(TAB(IT1)+G1) 

FNTE0800 

21 

G2  = THETA 2* ( TAB  ( IT2 ) +G2 ) 

FNTE0810 

23 

FNTERP  * RP1+G1  ♦ RP2*G2 

FNTE0820 

IF  (FNTERP.LT. 0.0)  FNTERP  - 0.0 

FNTE0830 

RETURN 

FNTE0840 

END 

FNTE0850 
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SUBROUTINE  HBELT (NSECT » I BAR, BAR f NT # XLONG ) 


REV  12 


HBEL001C 

12/19/74HBELCG20 


11 


COMPUTES  THE  FORCES  AND  TORQUES  OF  INDIVIDUAL  BELT  SECTIONS  AND 
ADDS  THEM  TO  THE  U1  AND  U2  ARRAYS  FOR  CONTACTING  SEGMENTS • 
ARGUMENTS: 

NSECT  - NO.  OF  REFERENCE  POINTS  ON  BELT 

lBAR(ltJ)  - SEGMENT  NO.  ASSOCIATED  WITH  PUINT  J 
( 2 » J ) - ELLIPSOID  NO.  <J=1,NSEC1) 

BAR  (1,J)  - INPUT  REFERENCE  POINT 
( 4 » J ) - CONTACT  POINT 

NT  - INDEX  TO  FORCE  DEFLECTION  FUNCTION 

XLONG  - REFERENCE  LENGTH 

IMPLICIT  REAL*B< A-H,0-Z) 

DIMENSION  B AR  ( 6 , 10) t IBAR (2 , 10) 

C0MM0N/C0NTRL/NSEG,NJNT,NS3,NJ3,NPL,NBLT,NBAG,NVEH,NGRND,NPRT(4Q ) 
COMMON /VPOSTN /TIME 

COMMON/SGMNTS/D(3,3,22) ,WMEG(3,22) ,WMEGD(3,22) ,U1 (3,22 ),U2(3, 22) 

* »SEGLP(3t  22) , SEGLV ( 3 t 22 ) » SEGLA ( 3 » 22 ) ,NSYM( 22) 
COMMON/CNT SRF/  PL (17,20 ) ,GAB ( 8 ,3 ) , BELT ( 20 ,3 ) ,TPTS<6,6) ,BD(24,25) 
C0MM0N/TEMPVS/TK3)  ,T2(  3 ) ,T3  < 3 ) ,TM  3 ) ,T5  (3)  ,T6  ( 3)  , T7  ( 3 ) , TB  (3  ) , 

* ZNR(3) ,ZW( 3,101 ),ZY( 3,100 ) ,DS( 100), JF( 101 ) 

CALL  ELTIME (1,36) 

LL  = G 

00  20  K*l, NSECT 

COMPUTE  ZW(K)  - THE  LOCATION  OF  POINT(K)  IN  INERTIAL  REFERENCE. 

KK  = IBAR ( 1 , K ) 

CALL  DOT (D(1,1,KK) ,BAR(4, K) ,T1,3,1,3) 

DO  11  J=1 ,3 

ZW(J,K)  = SEGLP ( J ,KK ) ♦ T1(J) 


12 


IF  (K.EQ.l) 
LL  = LL+1 
JJ  = JF(LL) 


GO  TO  20 


COMPUTE 

BETWEEN 


VECTOR 

POINTS 


ZY(LL)  AND 
K= JF ( LL+ 1 ) 


LENGTH 
AND  JJ= 


DS(LL) 
JF(LL) , 


FOR  BELT  SECTION  LL 


DSS  = 0.0 
DO  13  J=1 ,3 

ZY(J,LL)  = ZW(J,K)  - ZW(J,JJ) 

13  DSS  = DSS  ♦ ZY(J,LL)**2 
DS(LL)  = DSQRT ( DSS ) 

IF  (LL.EQ.l)  GO  TO  20 

COMPUTE  DPR  - DOT  PRODUCT  BETWEEN  ZY(LL)  AND  ZY(LL-l) 


KK  = 
MM  = 


IBAR< 1, JJ) 
IbAR(2, JJ) 


hBELC030 
HBEL0040 
HBEL0050 
HBEL0060 
HBELC07G 
HBELC06C 
HBEL0C90 
HBE  LG1C0 
HBELullC 
HBE  LO  120 
HBEL0130 
HBELG14G 
HBEL015C 
HBEL0160 
H BE  LU  170 
HBEL0180 
HBE  Lw  190 
HBELC200 
HBEL0210 
HBEL0220 
HBELC230 
HBEL0240 
HBE  LO 2>0 
HBE  LO  260 
HBEL0270 
HBELC2  80 
HBELC290 
HBEL0300 
HBEL0310 
HBEL0320 
HBEL0330 
HBEL0340 
HBELG35G 
HBELU360 
HBE  Lu370 
HBEL0380 
HBELG390 
HBE  LC  400 
HBELG410 
HBEL0420 
HBELC430 
HBELC440 
HBEL045G 
HBEL046G 
HBEL0470 
HBELG4SG 
HBEL049G 
HBELObOO 
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IF  (MM.EQ.C)  GO  TO 

DO  14  J=1 , 3 

14  T2(J)  = B AR( J +3 , J J ) - B0(  J + 3,  MM  ) 

CALL  M AT ( BD(  7, MM ) , T2 , T3 *3 ,3 , 1 * 3, 3 ,3 ) 

CALL  l>0T<D(ltlfKK)fT3tZNRf3tlt3) 

DPR  = 0.0 

DO  15  J=  1 , 3 

15  DPR  = OPR  ♦ ZNR  ( J ) * ( ZY  ( J,  LL  )/DS ( LL)  - Z Y ( J , LL-1 ) /DS  ( L L-l ) ) 

IF  (DPR.LT.C.C)  GO  TO  20 

POSITIVE  DPR  INDICATES  BELT  IS  PULLING  AWAY  FROM  POINT  J J . REMOVE 
POINT  FROM  FUTURE  CONSIDERATION  AND  DECREASE  LL  - NO.  OF  LENGTHS. 

LL  = LL-1 
GO  TO  12 

20  JFUL  + l)  * K 

COMPUTE  XLG  - TOTAL  LENGTH  OF  THE  LL  BELT  SECTIONS. 

XLG  = 0.0 
DU  30  L*1,LL 
30  XLG  = XLG  ♦ DS  ( L ) 

NEGATIVE  XLONG  INDICATES  INITIAL  SLACK  IN  BELT. 

IF  ( XLONG.LT. 0.0)  XLONG  = XLG-XLONG 

COMPUTE  FRC  - TOTAL  FORCE  OF  BELT  AND  APPLY  IT  TO  ALL  SEGMENTS. 

STRAIN  = ( XLG-XLONG) /XLONG 
FRC  = FRCDFL ( STRAIN, NT, 1 ) 

IF  (FRC. LE. 0.0)  GO  TO  99 

IF  ( N PRT ( 16 ) • NE .0 ) WRITE  (6,31)  TIME , XLG , STRAI N , FRC, LL 
FORMAT ( *0  SUB  HBELTf,F13.6,3Gl8.7,16) 

DO  40  L=1 , LL 
LI  = JF ( L ) 

L2  = JF( L ♦ 1 ) 

K 1 = 1BAR ( 1 , L 1 ) 

K 2 = 1BAR ( 1 , L2 ) 

CALL  MAT(  D(  1,  1,K1> , ZY ( 1 ,L ) , T4 , 3 , 3 , 1 , 3 , 3 , 3 ) 

CALL  MAT ( D ( 1 , 1 , K2 ) , ZY ( 1 ,L ) , TS , 3 , 3 , 1 , 3 , 3 , 3 ) 

CALL  CROSS (BAR(4,L1 ),T4,T6) 

CALL  CROSS ( B ARC  4 ,L2 ) , T5  ,T7 ) 

FR  = FRC/DS ( L ) 

IF  ( N PRT (16).NE.O)  WRITE  (6,32)  L 1 , K1 , K 2 , DS ( L ) , FR , ( ZY ( J, L ) , J= 1 , 3 ) 
F0RMAT(6X,316,5G18.7) 

DO  40  J=1 , 3 
Ul( J ,K1) 

U 2 ( J , K1 ) 

U 1 ( J , K2) 


31 


32 


UlCJtKl)  ♦ 
U2 ( J , K 1 ) ♦ 
U 1 ( J , K 2 ) - 


FR*  ZY ( J , L ) 
FR*  T6 ( J ) 
FR*  ZY ( J , L ) 


HBELG5 10 
HBEL052C 
HBELG53C 
HBELU54C 
HBEL0550 
HBEL0560 
H BE  Lo570 
HBE  LG  580 
H6EL0590 
HBEL0600 
HBEL0610 
HBEL0620 
HBEL063G 
HBEL064C 
HBEL0650 
HBEL066C 
HBEL0670 
HBEL0680 
HBEL0690 
HBEL070C 
HBEL071C 
HBEL0720 
HBEL073C 
h BE  LG 740 
HBELU750 
HBEL076C 
HBEL0770 
HBEL0780 
h BE  L0790 
HBE  LOBOO 
HBELuBlO 
HBEL0820 
H BE  Lu63C 
HBEL0840 
HBE  L0B5C 
HBEL0860 
H BE  L0870 
HBEL06BG 
HBELG69G 
HBEL09C0 
HBEL091C 
HBELC920 
HBELC93G 
H BE  Lu94u 
HBE  LO  950 
HBEL0960 
HBEL0970 
H BE  LO  980 
HBEL0990 
HBEL1CCG 
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FR*T7  (J) 


40  U2(  J * K2)  = U2(J»K2) 

99  CALL  ELTIM  E (2  » 36 ) 
RETURN 
END 


HBEL1010 

HBEL1020 

HBEL1030 

HBEL1040 
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SUBROUTINE  HINPUT 

CONTROLS  THE  INPUT  OP  CAROS  F.8.A  - 
CONTROL  OF  THE  HARNESS  B LLT  SYSTEM. 


H IN  PC  0 10 
REV  12  12/19/74H INPGC20 
F.8.0  CONTAINING  THE  SETUP  ANDHINPCC30 

HINP004C 
HINP0050 
HINPG060 
HINP0070 
H INPG08G 
H INP0090 
HINP0100 
HINP0110 


IMPLICIT  REAL*8( A-H,0-Z) 

COMMON/HRN ESS/  BAR(6,100)  , XL0NG(2C),  IBAR(2,100),  NTHRNS ( 20 ) » 

* NHRNSS*  NBLTPHt  5 ) » NFBLT(5,20),  NPTSPB(20) 

COMMON/TEMP  VS/ JTITLUB,  51)  ,N  F ( 5)  , NS  ( 3)  , KT  IT  L E ( 31 ) 

COMMON /TAB LES/MXNTI » MXN T B* MX TB 1 *MX T62 *NT I (50 ) ,NTAB ( 500 ), TAB ( 2000 ) 
COMMON/TITLES/  DATE ( 3 ) , COMENT < 40 ) , VPSTTL ( 20 ) , B OYTTL ( 5 ) ,BLTTT L < 5 , 8 ) H INPG1 2C 


* ,PLTTL (5,20) ,BAGTTL<  5 ,6 ) , S EG ( 2 2 ) , JO  I NT ( 2 1 ) 

* ,CGS ( 21 ) » JS( 21 ) 

REAL  DATE,COMLNT,VPSTTL ,BDYTTL .BLTTTL , PLTTL , BAGTTL ,SEG  ,J0INT 
LOGICAL+1  CGS , JS 

INPUT  CARO  F.8.A 

NHRNSS  - NO.  OF  HARNESS-BELT  SYSTEMS 
NBLTPH  - NO.  OF  BELTS  PER  HARNESS 

READ  (5,11)  NHRNSS,  (NBLTPHd  ),  1 = 1, NHRNSS) 

11  FORMAT ( 1SI4  ) 

IF  (NHRNSS. LE.O)  GO  TO  99 

WRITE  (6,12)  NHRNSS, (NBLTPH( I) ,1=1, NHRNSS) 

12  FORMA T ( • 1 HARNESS-BELT  SYSTEM  INPUT' ,93X , 'CAROS  F.8'// 

* • NO.  OF  HARNESSES  =',I4// 

* • NO.  OF  BELTS  PER  HARNESS  =',5I6) 

J1  = 1 

K1  = 1 

JJ1  = MXTB2  + 1 
NT  = MXNTB  ♦ 1 
00  9U  1=1, NHRNSS 
IF  (NBLTPHd). LE.O) 

J2  = J 1 ♦ NBLTPHd  ) 


GO 

-1 


TO  90 


INPUT  CARO  F.8.B  - NPTSPB  - NO.  OF  POINTS  PER  BELT. 

READ  (5,11)  (NPTSPBt J), J=J1, J2 ) 

WRITE  (6,13)  I, (NPTSPBt J),J=J1,J2) 

13  FORMAT ( '0  FOR  HARNESS  NO. ',13,'  NO.  OF  POINTS  PER  BELT  =',20I4) 
00  80  J=J1,J2 

IF  (NPTSPB (J) .EQ.O)  GO  TO  80 

INPUT  CARO  F.8.C  - 5 FUNCTION  NOS  AND  LENGTH  OF  EACH  BELT. 

READ  (5,14)  (NFBLT ( L, J ) ,L=1,5 ) ,XLONG( J ) 

14  F0RMAT(5I4,F12.6) 

WRITE  (6,15)  I,J,(NFBLT(L,J) , L =1 , 5 ) , XLONG ( J ) 

15  FORMATCO  HARNESS  NO.',U,'  BELT  NO. ',13,'  FUNCTION  NOS. ',516, 


HINPG130 
HINP0140 
HINP0150 
HINPC160 
HINP017O 
H INP0180 
HINPC190 
H INP0200 
HINPG210 
HINPC220 
H IN  PC  230 
H INP024C 
nINPu25G 
HINP0260 
H INPC27G 
HINPG28G 
H INP0290 
H INP0300 
HINPG310 
H INP032G 
H INPG330 
HINP034C 
H INPG35G 
HINPC360 
H INP0370 
HINPG38C 
HINPG39G 
HINPG400 
HINP041C 
HINP0420 
HINPG43G 
H INPC440 
HINP0450 
HINPG46G 
HINPG47G 
H INPG480 
HINPG49G 
HINPOBGG 
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* • REFERENCE  LENGTH  =f,G16.8/// 

* • HARNESS  BE  LI  POINT  StGMENT  ELLIPSOID  S 

* 9X, PREFERENCE  POINT • / 

* 3X  » 1 NO • • t 5X ? • NO*  * ,3X,  "NO. • , 6X, »N0 . • f 6X, »N0 • • ,6X » 

* 6X,lXl,9Xf  »Y#fVXf  •ZS  3X  / ) 

CHANGE  SIGN  OF  XLONG  FOR  INITIAL  CALL  TO  HBtLT. 


XLONG(J)  = -XLONG(J) 


SET  UP  POINTERS  IN  NTAB  AND  INITIAL  VALUES  OF  TAB  FUR  bELT  J 
AS  WAS  DONE  FOR  OTHER  CONTACTS  IN  SUBROUTINE  FINPUT. 

NTHRNS(J)  = NT 
NTAB(NT)  = JJ1 
NT  = NT+1 
DO  17  L = 1 , 5 
NTAB(NT)  = 0 
NX  = NFBLT ( L»  J ) 

IF  (NX.EQ.O)  GO  TO  17 
NTAB(NT)  = NT  I ( NX ) 

IF  (NTI (NX) *GT*0)  GO  TO  17 
WRITE  (6,16)  NX 

16  FORMAT ( *0  FUNCTION  NO*#,I4,#  HAS  NOT  BEEN  DEFINED* • , 

♦ 1 PROGRAM  TERMIN  A1E  D* • ) 

STOP 

17  NT  = NT ♦! 

JJ2  - JJ1+19 

DO  18  JJ=J  J 1 1 J J2 
16  TAB ( J J ) = 0.0 
NX  = NT  AB ( NT-6 ) 

IF  (NX.LT.O)  GO  TO  19 
TAB(JJi+8)  = DABS ( TAB  ( NX  +1 ) ) 

IF  (TAB(NX+2 ) .NE.O.O)  TABUJ1+8)  = DABS ( TAB ( NX+2) ) 
TAB(JJWO)  = EVALFD(TAB(JJ1+8),NX,1) 

NX  = NT  AB ( NT-4 ) 

IF  (NX.LE.O)  GO  TO  19 
TABCJJl+9)  * D ABS  ( T AB(  NX+1 ) ) 

IF  ( T A6 (NX  + 2 ) .NE.O.O)  TAb(JJl+9)  = DABS ( TAB ( NX+2 ) ) 

19  JJ1  = JJ2+1 

K2  = K1  ♦ NPTSPB(J)  - I 
DO  70  K-Kl , K2 

INPUT  CARD  F.8.D 


21 

22 


READ  (6,21)  (IBAR(L,K),L=1,2) 

WRITE  (6,22)  I , J ,K, ( IBAR (L ,K ) , L=l, 2 ) 
F0RMAT(2I6,3F12.6) 

FORMAT  ( 16,18, 16, 218, 7X, 3 FI 0.3) 

DO  23  L=I , 3 


( B AR ( L , K ) , L= 1 ,3 ) 
(BAR(LtK) ,L=1,3) 


HINP06IC 
HINPC  620 
H IN  PO  630 
HINPG640 
HINPC660 
H INPO  660 
HINPG670 
HINP068C 
HINP0690 
HINPC600 
HINP0610 
H INPO  620 
H IN  PO  63  0 
HINPG640 
H INP0660 
H IN  PC  660 
HINPG670 
HINP068C 
HINP0690 
HINP0700 
H INPO 710 
H INP0720 
HINP0730 
H INPu  740 
HINPC  760 
H IN  PC  76  0 
H INP0770 
HINP078C 
HINP0790 
H IN  PO  800 
H INPC810 
HINP0820 
H IN  P063C 
H INP0B4C 
H INPO  860 
H IN  PO  860 
HINP0870 
HINP0880 
HINP0890 
HINP0900 
HINP0910 
HINP0920 
HINP0930 
H IN  Pu940 
HINP0960 
HINP096C 
HINP0970 
HINP0980 
H INPO 990 
HINP1CCC 
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BAR (L,K  ) 


BAR ( L+3 ,K ) = bAR (L»K  ) HINPI010 

CONTINUE  HINP102G 

K1  = K2  + 1 H INP1C3G 

CONTINUE  HINPIC4C 

J1  = J2+1  HINP1G50 

CONTINUE  HINP1C60 

MXNTB  = NT-1  NINP1G70 

MXT82  = JJ1-1  H IN  P 1 080 

IF  (MXTB2.GT.2C00)  WRITE  (6,62)  MXTB2  HINP1090 

FORMAT ( *0  ERROR  IN  SUBROUTINE  HINPUT,  SIZE  OF  TAB  ARRAY  =',I8//  HINP11GG 

* • PROGRAM  TERMINATED.*)  HINP1110 

IF  (MXTB2 .GT.2000)  STOP  HINP112C 

99  RETURN  HINP113G 

END  HINP1140 


23 

70 

80 

90 


62 
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SUBROUTINE 


1MPULS( 11,12,13) 

REV  12 

1 - IMPULS  FOR  PLELP. 

3 - IMPULS  FOR  SEGSEG* 

4 - IMPULS  FOR  VIS  PR  OR  EJOINT 
INDEX  OF  CONTACTING  SEGMENT  OR  JOINT  AXIS 
PLANE,  SEGMENT, OR  JOINT  NUMBER 


ARGUMENTS:  II  = 


12 

13 


IMPLICIT  REAL*8  (A-H,0“Z) 

COMMON/CONTRL/NSEG ,NJNT ,NS3,NJ3,NPL,NBLT ,NbAG , NVEH ,NGR  ND, NPRT (40 ) 
COMMON /VPOSTN/  TIME, XO(3),XDOT 0(3), XC0MP(3) , XVCOMP (3 ) , AX (3) , 

* ANGLE ( 3 ) , VMPH, VTIME , ATAB ( 15,100) , ATO ,ADT , OMEGA , 

* NATAB,NACLR,DVEH(3,3),VMEG(3) , VM EGD ( 3 ) , X ACOMP ( 3 ) , 

* THET ( 3 ) ,ZPLT (3 ) 

COMMON/SGMNTS/D( 3,3,22) ,WMEG(3,22) ,WMEGD ( 3 ,22 ) ,U 1 ( 3, 22 ) ,U2 ( 3, 22 ) 

* ,SEGLP( 3,22) , S EGLV ( 3 , 22 ) , S EGL A ( 3 , 22 ) ,NSYM(22) 
C0MM0N/CMATRX/V1(3,21) ,V2( 3,21) ,V3 (3,12 ) ,B12 ( 3,3 ,42 ) , A22 (3 , 3 ,42 ) 

* ,F(3,21),TQ( 3,21 ),WJ(21) 

COMMON/DESCRP/  PH  1 ( 3 , 22 ) ,W ( 22 ) ,SR ( 3, 42 ) , HA( 3 ,42 ) , HB ( 3 , 42 ) 

* ,HT(3,3,42),RPH1 (3 , 22 ) , RW ( 22 ) , SPR 1NG ( 5,6 3 ) 

* »VISC(7,63),JNT(21) ,IP1N(21) ,NS,IS1NG(22 ) 

* , I GLOB ( 21 ) 

CQMMON/JB ARTZ/  MNPL(  20),MNBLT(  8),MNSEG(  22),MNBAG(  6), 

* MPL(3,5,20) ,MBLT( 3,5,6) ,MSEG( 3 , 5, 22 ) , MBAG ( 3 , 10 ,6 ) , 

* NTPL( 5,2G),NTBLT(5,6),NTSEG(5 ,22) 


1MPUG010 
10/25/741 MPUOC 20 
1 MPU0030 
I MPUG040 
1 MPU0050 
IMPU0060 
I MPU007G 
1MPUC060 
1MPU0090 
1MPU0100 
1MPU0110 
IMPUG120 
IMPU0130 
1MPUC140 
1MPUO150 
1MPU0160 
1MPUC170 
IMPU01B0 
1MPUG190 
I MPU0200 
IMPUC210 
IMPU0220 
1MPU0  230 
IMPUC240 
I MPU0250 
1 MPUG26C 


COMMON  /CST  RNT /A13(3,3,24),A2  3( 3, 3 , 24 ) , B3 1 ( 3 , 3, 24) ,B32( 3,3,24) 

* ,HHT(3,3,12),RK1(3,12) ,RK2 ( 3 , 12 ) , QQ( 3 , 12 ) ,TQQ(3,12) 

* ,RQQ(3, 12) ,HQQ(3, 12) ,SQQ( 12 ) ,CFQQ( 12 ) 

* ,NQ,KQ1( 12) ,KQ2 ( 1 2 ) , KQTYPE ( 12) 

COMMON/ FLXBLE/  HF (4 , 12, 6 ) , B42 ( 3, 3 , 24 ) , V4 ( 3, 8 ) , NFLE X( 3 , 8 ) , NFLX 
COMMON/TAB LES/MXNT I, MXNTB, MXTB 1 ,MXTB2,NT I ( 50 ) ,NTAB (500 ), TAB ( 2000) 
COMMON/TEMPVI / TT1 (3 ) ,R II (3) ,R2I ( 3 ) ,CRES T , J STOP (4 , 2,2 1 ) 

DIMENSION  TEMP (3 ),DWR1( 3),DWR2(3) ,DWR3(3) ,DWR4(3) , VREL (3) ,DV(3) 

IF  (TIME. EQ. 0.0)  GO  TO  99 

SPECIAL  SETUP  FOR  CALL  TO  SUBROUTINE  DAUX 
REPLACE  SETUP  WITH  U 1 , U 2 ,V 1 , V2 , V3  = 0. 

ASSUME  OTHER  ARRAYS  FROM  PREVIOUS  CALL  TO  DAUX. 

CALL  ELTIME( 1,27) 

CALL  OUTPUT ( 0 ) 

KQTEST  = 0 
NT  = 0 


IF 

(11  • EQ  • 1 ) 

NT 

= NTPL 

( 12,1 

3) 

IF 

(I1.EQ.3) 

NT 

= NTSEG 

(12,1 

3) 

IF 

(NT.EQ.O) 

GO 

TO  29 

KQ 

= -NTAB ( NT+1 ) 

IF 

(KQ.LE.O) 

GO 

TO  29 

KQTYPE ( KQ ) = 

I ABS ( KOTYP 

a 

* 

LU 

) 

IMPUC27G 
IMPUG280 
I MPU0290 
I MPUu300 
IMPU0310 
1 MPU0320 
I MPU0330 
1MPU0  34G 
I MPU0350 
IMPUC360 
1 MPU0370 
I MPU0380 
I MPU0390 
1 MPU0400 
IMPU041G 
IMPUC420 
I MPU0430 
IMPU044G 
I MPU0450 
I MPUG46G 
I MPU0470 
I MPU0480 
IMPU049C 
IMPU05C0 
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CALL  DAUX(O) 

IMPUC51C 

29 

IF  (NQ.LE.O)  GO  TO  31 

I MPUG52G 

DO  30  J=1 , NQ 

IMPUO530 

DO  30  1=1,3 

I MPUl  540 

30 

V3 ( I , J ) = 0.0 

I MPU0550 

31 

DO  32  J=1  ,NSEG 

I MPUG560 

DO  32  1=1,3 

IMPUC570 

U1(I,J)  = 0.0 

I MPUG58G 

32 

U2(I,J)  = 0.0 

IMPU059C 

IF  (NJNT.LE.O)  GO  TO  21 

I MPUC60G 

DO  33  J=1,NJNT 

IMPU061G 

DO  33  1=1,3 

I MPU062G 

Vl(ItJ)  = 0.0 

I MPU0630 

33 

V2(I,J)  = 0.0 

I MPU0640 

21 

IF  (NFLX.EQ.O)  GO  TO  23 

I MPUG650 

DO  22  J=1 ,NFLX 

IMPU0660 

DO  22  1=1,3 

I MPUC670 

22 

V4 ( I , J ) = 0.0 

I MPUG68G 
1MPU0690 

REPLACE  CALLS  TO  CONTACT  AND  VISPR  WITH  SINGLE  CALL 

IMPU070G 

AT  FIRST  CONTACT  IF  NOT 

CONSTRAINT. 

IMPU0710 

IMPUG720 

23 

IF  (I l.NE. 1)  GO  TO  34 

I MPUG730 

NT  = NTPLt 12,13) 

IMPU0740 

Ml  = MPL ( 1,12,13) 

IMPU075C 

M2  = MPL ( 2,12,13) 

I MPU076G 

M3  = MPL ( 3,12,13) 

IMPU077C 

CALL  PLELPf M2 , M3 1 Ml , 13 ,1 

NT) 

I M PUG 780 

IF  CNTABCNT+ll.LT.O)  GO 

TO  37 

I MPUG79G 

K 1 = M2 

I MPUG8GC 

K2  = Ml 

IMPU0810 

GO  TO  39 

I MPUG820 

34 

IF  (I1.NE.3)  GO  TO  35 

I MPUG830 

NT  = NTSEG (12,13) 

I MPU084G 

Ml  = MS EG (1,12,13) 

I MPUG85G 

M2  = MSEG( 2,12,13) 

I MPUC860 

M3  = M SEG ( 3 , 12 , 1 3 ) 

1MPU0870 

CALL  SEGSEG(I3 , Ml, M2, M3 

,NT  ) 

I MPUu  880 

IF  ( NT  AB( N T +1 ).LT.O)  GO 

TO  3 7 

I MPU0890 

K1  = 13 

I MPUG900 

K2  = M2 

I MPUG91G 

GO  TO  39 

IMPU092G 

35 

IF  (I1.NE.4)  WRITE  (6,36)  11,12, 

13 

I MPUG930 

36 

FORMAT  CO  IMPROPER  ARGUMENTS  TO 

SUBROUTINE  IMPULS*/ 

IMPU0940 

* 1 ARGUMENTS  = • 

, 316  / 

I MPUG950 

* • PROGRAM  TERMINATED*  ) 

I MPU0960 

IF  (I1.NE.4)  STOP 

I MPUG97G 
IMPU098G 

RECALL  VISPR  FOR  JOINT 

STOP. 

IMPUG99G 
I MPUl GOG 
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IF  (IABS(1PIN(I3)).NE.4)  GO  TO  25 
CALL  t JOINT ( I 2 ♦ 1 3 ) 

GO  TO  26 

25  CALL  VI SPR ( 12 1 13 ) 

26  K1  = I ABS ( JNT ( 13) ) 

K 2 = 13+1 

GO  TO  39 

SET  UP  SPECIAL  U1,U2  FOP  FIRST  CONTACT  OF  CONSTRAINT. 


- 1 ABS ( KQTY  PE(  KQ ) ) 


37  KQ  = -NTA  b ( NT  + 1 ) 

KQTEST  = I 
KQTYPE(KQ)  = 

K1  = KQKKQ) 

K2  = KQ2( KQ  ) 

IF  (Kl.GT.NSEG)  GO  TO  38 
CALL  MAT (AI3( 1,1,2*KQ— 1 ) 
CALL  MAT<A23(1,1,2*KQ~1) 

38  IF  (K2.GT.NSEG)  GO  TO  39 

CALL  MAT( A13( 1 ,1 ,2*KQ  ) 

CALL  MAT(A23( ltI ,2*KQ  ) 

FINAL  SETUP  OF  UI  AND  U2 


,QQ(1,KQ> ♦Ul(ltKI) ,3,3, 1,3,3, 3) 
♦QQ(ltKO) ,U2 (1,K1) ,3, 3, 1,3, 3, 3 ) 

,QQ( 1,KQ) ,U1( 1,K2),3,3,1,3,3,3 ) 
»QQ( It KQ) f U2( It K2) f3f3t It  3 f3f 3 ) 


39  DO  4G  J = I t N SEG 
DO  40  I =1 1 3 

UI ( I f J)  = Ul( I tJ ) *R  W ( J ) 

40  U2 ( 1 9 J ) = U2(If J)*RPHI( I fj ) 

DO  41  1=1,3 

SEGL A ( I ,N VEH)  = C.C 

41  WM EG D ( I,NVEH)  = O.v 
CALL  DAUX(Il) 

IF  (KQTEST. EQ.l)  KQTYPE ( KQ ) = I ABS (KQTY PE (KQ  ) ) 

IF  (NPRT(IO).NE.O)  CALL  PR INT ( 6HPRE1MP ) 

IF  (I1.GT.3)  GO  TO  51 

IF  ( NPRT ( 1 0 ) • N E.O ) WRITE  (6,42)  R11,R21 

42  FORMAT  ( 1 0 1 /( 6G20.8 ) ) 

CALL  CROSS  ( WMEG  ( 1 , K 1 ) , R II  ( 1 ) , TEMP  ) 

CALL  DOT ( D ( 1 , 1 ,K 1 ) , TEMP , DWRl ( I ) ,3, 1,3) 

CALL  CROSS (WMEG  ( 1 ,K2 ) , R21 ( 1 ) ,TEMP ) 

CALL  DOT (D(1,1,K2), TEMP, DWR2(1 ),3, 1,3) 

CALL  CROSS (WMEGD( 1,K1),R1I ( 1 ) , TEMP ) 

CALL  DOT ( D ( 1,1,K1),TEMP,DWR3(1 ), 3, 1,3) 

CALL  CROSS(WMEGD(l,K2),R2I (1),TEMP) 

CALL  DOT (D( 1, 1 ,K 2 ) ,TEMP,DWR4(1 ),3,1,3) 

TVREL  = C.O 
TDV  = 0.0 
DO  50  1=1,3 

VREL(I)  = S EGLV ( 1 ,K 1 ) +DWR1 (I ) - S EGLV ( I ,K2 ) -DWR2(I) 
DV  (I)  = SEGLA(I,K1)+DWR3(I ) - SEGLA( I , K2 )-DWR4( I ) 


IMPU1010 
IMPU1G2G 
1MPU1030 
IMPU1040 
IMPU1050 
I MPU1G60 
1MPU1070 
I MPU1080 
IMPU1090 
1MPU110C 
IMPU1110 
IMPU1120 
IMPU113C 
IMPU1140 
IMPUI 150 
1MPU1160 
IMPU1170 
IMPU118G 
IMPU1190 
IMPUI 200 
IMPU121Q 
IMPU122G 
IMPU123G 
1MPU124G 
IMPU125G 
IMPU1260 
IMPU1270 
1MPU128G 
IMPU1290 
I MPU130G 
IMPU1310 
IMPU1320 
1MPU133G 
1MPU134U 
IMPU135G 
1 MPU1360 
IMPU137C 
IMPU138U 
I MPU139G 
1 MPU14C0 
I MP  UI 4 1C 
1 MPU142G 
IMPU1430 
IMPU144U 
I MP  UI 450 
1MPU1466 
1MPU147C 
IMPU148G 
1MPU1490 
IMPU15G0 
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50 

51 


52 

53 


60 


99 


TTI ( I ) * V RE  L ( I ) 
TTI ( I ) *DV  (I) 


( 1 1 K 1 ) ,DWR1( 1) ,3,1,3) 


TVREL  = TVREL 
TDV  = TDV 
GO  TO  53 

CALL  DOT (D(1,1,K1),  WMEG 
CALL  DGT(D( 1, 1,K2) ,WMEG  ( 1 , K2 ) , DWR2 ( 1 ) , 3 , 1 ,3 ) 

CALL  DOT ( D ( 1 , 1 , K1 ), WMEGD ( 1 , K 1 ) , DWR 3 ( 1 ) , 3 , 1 , 3 ) 

CALL  DOT(D( 1,1 ,K2 ), WMEGD (1,K2) ,DWR4( 11,3,1,3) 

TVREL  = 0.0 
TDV  * 0.0 
DO  52  1=1,3 

VREL(I)  = DWRI(I)  - DWR 2(1) 

DV  (I)  = DWR3 ( I ) - DWR4 ( 1 ) 

TVREL  = TVREL  ♦ TTI ( 1 )* VRE L ( I ) 

TDV  = TDV  ♦ TTI ( 1 )*DV  (1) 

ALPHA  = 0.0 

NOTE:  CREST  IS  SUPPLIED  AS  (l+E)/2  WHERE  E IS  THE  CLASSICAL 
COEFFICIENT  OF  RESTITUTION  BUT  WITH  A RANGE  OF  -1  TO  +1. 

CREST  HAS  A RANGE  OF  0 TO  +1  WHERE  0 (E=-l)  REPRESENTS  NO  IMPULSE 

IF  (TDV.NE.O.O)  ALPHA  = -2 .0 *CREST*TVRE L/TDV 

IF  ( NPRT ( 10 ) • NE .0)  WRITE  (6,42)  DWR1 ,DWR2 ,DWR3 ,DW R4, 

* TT 1 , VRLL ,DV , 

♦ TVREL, TDV, CREST, ALPHA 
DO  60  J=1 , NSEG 

DO  60  1*1,3 

SEGL V ( 1 ,J ) = SEGL V ( 1 , J ) ♦ AL PH A*SEGLA ( I , J ) 

WMEG  (I,J)  = WMEG  (I,J>  + AL PH A*WM tGD( I , J ) 

CALL  OUTPUT ( 1 ) 

CALL  PRINT (oHIMPULS) 

CALL  ELTIME (2,27) 

RETURN 

END 


IMPU151C 
IMPU1520 
1 MPU1530 
IMPU1540 
IMPU155L 
I MP  Ul 560 
1 MPU157G 
1MPU1580 
IMPU1590 
IMPU1600 
IMPU1610 
IMPUlo20 
1 MPU1630 
1MPU1640 
1 MPU1650 
1MPU166G 
I MPU1670 
I MPU1680 
► I MPU1 69C 
IMPU17G0 
IMPU1710 
I MPU1720 
IMPU1730 
IMPU174C 
IMPU1750 
IMPU1760 
IMPU1770 
IMPU1780 
IMPU1790 
I MPU18C0 
IMPU1810 
IMPU162C 
IMPU1830 


i 

I 

I 


I 
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SUBROUTINE  KINPUT  KINP0010 

REV  12  12/II/74K INPG020 

PERFORMS  THE  FOLLOWING  CARD  INPUT  AFTER  CARDS  E.1-E.4  (SUBROUTINE  KINP003C 


CINPUT)  AND  BEFORE  CARDS  F.I-F.5  (SUBROUTINE  FINPUT). 

CARD  E.5  - NWINDF:  NO.  OF  WIND  FORCE  FUNCTIONS  ON  CARDS  E.6 
- NJNTF  : NO.  OF  JOINT  FORCE  FUNCTIONS  ON  CARDS  E.7 
CARDS  E.6  - DEFINITIONS  OF  WIND  FORCE  FUNCTIONS 
CARDS  E.7  - DEFINITIONS  OF  JOINT  RESTORING  FORCE  FUNCTIONS 


K INP0040 
KINP0G50 
KINP006G 
K INPG070 
KINPGG8G 
KINP0090 

IMPLICIT  REAL*8(A-H,0-Z)  KINPCIOO 

COMMON /TAB L ES/MXNT I » MXNTBf  MXTBlfMXTB2,NTI(50)»NTAB(5G0),TAB( 2COC ) KlNPOllO 
COMMON/TEMP VS/ JTI TLE ( 5 » 5I)»NF(5)»NS(3) ,KTITLE ( 31 ) , TH( 5 0)  KINPGI20 

NOTE:  TEMPVS  IS  SHARED  HERE  WITH  SUBROUTINES  CINPUT  AND  FINPUT.  K IN PG13G 
REAL  BLANK/ 1 1 / , J TI TLE, KT ITLE  KINP0I40 

COMMON /CNSNTS/  PI*  R ADI  AN, G, TH IRD, EPS1 , EPS4, EPS6 , EPS8 , KINP0I50 

* EPSI2,EPSI5,EPS20,EPS24,UNITL,UNITM,UNITT,GRAVTY(3)KINPCI60 

KINPGI70 

INPUT  CARD  E.5  - NWINDF  AND  NJNTF  KINP018G 

KINP0190 
KINPG200 
KINPG210 
KINP0220 
K IN  PG  230 
KINPC240 
K INP0250 
KINP0260 
K INP027G 
KINP028G 
KINPG290 
K INPG3G0 


READ  (5*11)  NWINDF, NJNTF 

11  FORMAT  ( 216  ) 

JI  = MXTB1  + 1 

IF  (NWINDF. LE.O)  GO  TO  31 
DO  30  K=I, NWINDF 

INPUT  CARD  E.6. A - FUNCTION  NO.  AND  TITLE 

READ  (5*12)  I*  (KTITLEU  ) ,J  = 1,5) 

12  FORMAT ( I4,4X,5A4) 

WRITE  (6*13)  I, (KTITLEU), J=1,5)*I,J1 

13  FORMAT ( *1  WIND  FORCE  FUNCTION  NQ.*»I4,4X,5A4,10X, * NTI  ( ,,I2, 1 ) = *,  KINPG310 


* 15, 43X, ’CARDS  E.6*//) 

IF  (I.LE.G.0R.I.GT.5Q)  WRITE  (6,14) 

14  FORMA  T ( *0  IMPROPER  FUNCTION  NO.  PROGRAM  TERMINATED.*) 
IF  (I. LE.O. OR. I. GT. 50)  STOP 
IF  (NTI(I).NE.O)  WRITE  (fc,15>  I 


KINP0320 
K INP0330 
K IN  PO  340 
KINPC35G 
K IN  Po56G 


15  FORMAT ( *0  FUNCTION  NO.*, 14,*  HAS  ALREADY  BEEN  INPUTTED  AND  WILL  BEKINP037G 


* REPLACED  BY  THIS  FUNCTION.*) 

NTI ( I ) = Jl 
DO  16  J=I,  5 

16  JTITLE(J,I)  = KTITLEU) 

J2  = J 1+4 

INPUT  CARD  E.6.B  - DO  THRU  D4  (FOR  NOW  A BLANK  CARD) 

READ  (5,17)  ( TAB( J ) , J= J 1, J2 ) 

WRITE  (6,18)  ( TAB ( J ) , J= J 1, J2 ) 

17  FORMAT (6F12.0) 

18  FORMAT  ( IOX, *D0*, 13X, *DI * , I3X, 1 D2  * , I3Xt * D3 * , 1 3X ♦ *D4*/5F 15.4// ) 
Jl  = J2+I 


K INPC38G 
KINPG390 
KINP0400 
KINPG410 
KINP0420 
K INP0430 
KINP0440 
KINP045C 
KINP0460 
KINPG47G 
KINP0480 
K IN  PC  490 
K INP0500 
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INPUT  CARD  E.6.C  - NTMPTS 

READ  (5,11)  NTMPTS 
WRITE  ( 6t 1 9 ) NTMPTS 

19  FO  RM  AT  ( *0  WIND  FORCE  TABLES  FOR  ',16,*  TIME  POINTS.*// 

* 11X, »T» 9 14X?*FX(T)»tI5X»*FY(T)f « 15X, • FZ(T) • /) 

TAB(Jl)  = NTMPTS 

JI  = Jl+1 

J2  = J1+4*NTMPTS-1 

INPUT  CARDS  E.6.D-E.6.N  - NTMPTS  CARDS  OF  T ♦ FX ( T ) , FY ( T ) , F Z ( T ) 

READ  (5,20)  ( TAB ( J ) , J=J 1, J2 ) 

WRITE  (6,21)  (TAB (J ) ,J=J1,J2 ) 

20  F0RMAT(4F12.0) 

21  FORMAT (3X,F12.6,3G20.6) 

Jl  = J2  + 1 

30  CONTINUE 

31  IF  (NJNTF.LE.C)  GO  TO  51 
DO  50  K=1 , N JNTF 

INPUT  CARD  E.7.A  - FUNCTION  NO.  AND  TITLE 

READ  (5,12)  I,(KTITLE( J), J=l,5) 

WRITE  (6,32)  I,(KTITLL( J ) , J* 1 , 5) , I , J 1 

32  FORMA  T ( *1  JOINT  FORCE  FUNCTION  NO . 1 , I4,4X,5A4, 10X , *NTI ( • , I 2, • ) 

♦ 1 5 ,42X, • CARDS  E.71//) 

IF  (I.LE.0.0R.1.GT.50)  WRITE  (6,14) 

IF  ( I.LE.0.OR.I.GT.50)  STOP 
IF  ( NT  I (I ) .NE • 0 ) WRITE  (6,15)  I 
NT  I ( I ) = Jl 
DO  33  J=1 , 5 

33  JT IT L E ( J, I ) = KTITLE(J) 

INPUT  CARD  E.7.B  - DG,D 1 ,D2 ,D3 ,04  (FOR  NOW  A BLANK  CARD). 

J2  = Jl+4 

READ  (5,17)  ( TAB ( J ) , J~ J 1, J2 ) 

WRITE  (6,18)  (TAB(J) , J= J 1, J2 ) 

Jl  = J2  + 1 

INPUT  CARD  E.7.C  - N THE T A, NPHI 

READ  (5,11)  NTHETA,NPH I 
TA  B ( J 1 ) = NTHETA 

TAB(J1  + 1)  = NPMl 
Jl  = Jl+2 

IF  (NTHETA.LT. 0)  GO  TO  38 
DO  35  J=l, NTHETA 


KINP051G 
KINP052C 
KINPU530 
KINPC540 
K INP0550 
KINPG56U 
KINP0570 
K INP058C 
KINP059G 
K INP0600 
KINP0610 
KINP0620 
KINP0630 
K IN  PO  640 
K INP0650 
KINP0660 
KINP0670 
K1NP0680 
KINP0  69C 
K INP0700 
KINPG710 
K INP0720 
K INP0730 
KINP074G 
KINP0  750 
KINP0760 
= 1 , K INP0770 
KINP0780 
KINP0790 
KINP0800 
K IN  PO  8 10 
KINPG620 
KINPC830 
K INP0840 
KINP0850 
KINP0860 
KINP0870 
KINP0880 
K INP0696 
K INP0900 
KINPuVlO 
KIN  P092  0 
KINP0930 
KINPC94C 
KINP0950 
K INPC960 
K INPC970 
K INP0980 
KINP0990 
K INP 1000 
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35  TH ( J ) = DFLOAT (J-1)*180.G/ DFLOAT (NTHETA-1)  K1NP1C1C 

WRITE  (6,36)  NTHETA,NPH1,(TH(J ),J=2,NTHETA)  K1NP1U20 

36  FORMAT ( '0  FUNCTION  IS  TABULAR  FOR'  ,13,*  X',I3,'  VALUES  OF  THETA  AK INP1G3G 

*ND  PHI  • //30X,  'THETA'/5X,  'PHI  • , 5X,  'THETAO  • ,F16.3,4F20.3/  K1NP1G40 

* ( 15X, 5F20 .3 ) ) K 1NP1G50 

37  FORMAT (F9.2,F10.3,5G20.7/( 19X,5G20.7) ) KINP1U60 

GO  TO  40  K 1NP1070 

38  NPOLY  = -NTHETA  -1  KINP108G 

WRITE  (6,39)  NPOLY, NPHl , (BLANK, J,J=1, NPOLY)  K1NP1G90 

39  FORMAT ( '0  FUNCTION  IS  COEFFICIENTS  OF*  ,13,'  ORDER  POLYNOMIALS  IN  KINPI100 

* (THET A-THET AO ) FOR', 13,'  VALUES  OF  PHI.'//  K1NP111G 

* 27X, 'COEFFICIENTS  OF  ( THET A-THETAO )**N '/  KINP112G 

* 5X, 'PHI* ,5X , 'THETAO' ,7X,5(A4, 'N  = • , 12 , 1 IX ) / ( 26X , A4 , • N = • , 12 , 1 1 X ,K 1NP1 130 

* A4, 'N  =• ,12, 11X.A4, 'N  =' ,12, 11X,A4, 'N  = * , 1 2, 11X , A4 , ' N =',121  ) 

4C  WRITE  (6,21) 

DO  49  1=1, NPHl 

PH1DEG  = UFLOAT( 1-1 ) *36  0 .0 /DFLOAT ( NPHl ) - 180.0 


INPUT  CARDS  E.7.D  - E.7.N  NPHl  SETS  WITH  NTHETA  ITEMS  PER  SET. 
EACH  SET  1 IS  FOR  PHIII)  = -18C  + ( 1-1 ) *36 C/NPH 1 DEGREES  AND 
ASSUMES  DATA  FOR  PHKNPHI+l)  = 180  IS  SAME  AS  PHl(l)  = -180. 

J2  * J 1 + IABS (NTHET A)  -1 
READ  (5,17)  (TAB( J) ,J=J1, J2) 

WRITE  (6,37)  PHIDEG, (TAB(J), J=J1,  J2) 

IF  (NTHETA. LT.O)  TAB(Jl)  = TAB ( J 1 ) *RAD1 AN 
IF  (NTHETA. LT.O)  GO  TO  49 

FOR  TABULAR  DATA,  FILL  IN  ZERO  VALUES  WITH  INTERPOLATED  NEGATIVE 
VALUES.  OVERWRITE  VALUE  IN  FIRST  COLUMN  (SUPPLIED  AS  THETAO)  WITH 
VALUE  FOR  THETA  = 0 AND  ALL  OTHER  ZERO  VALUES. 


♦ 1.0  ♦ EPS6 


THETAO  = TAB(Jl) 

IF  (THETAO. EQ. 0. 0 ) GO  TO  49 
JJ  = THETAO*DFLOAT ( NTHET  A— 1 ) /180. 0 
JJ1  = Jl+JJ 
1ERR0R  = 0 

IF  (JJ1.GT.J2)  1 ERR OR  = 1 
IF  (TAB(JJl).LE.O.O)  IERROR  = 2 
IF  (IERROR. NE.O)  GO  TO  46 
DO  45  J=1,JJ 
J1J  = Jl+J-1 

IF  (J.NE.l.AND.TAB(JlJ) . GT .0.0 ) IERROR  = 3 

45  TAB(JIJ)  = TA8(JJ1)*(TH(J)-THETA0)/(TH(JJ+1)-THETA0) 

46  IF  (IERROR. NE.O)  WRITE  (6,47)  IERROR 

47  FORMAT ( *0  INPUT  ERROR.  INCONSISTENT  VALUE  OF  THETAO.  IERROR  = • , 12 ,K IN P146C 

* • PROGRAM  TERMINATED.')  KINP147G 

IF  ( IERROR. NE.O)  STOP  KINP148G 

49  J1  = J2+1  KINP1490 

50  CONTINUE  K1NP150C 


K IN  PI 140 
K IN  PI 150 
K1NP1160 
KINP1170 
KINP118C 
K1NP1190 
K 1NP1200 
K1NP121G 
K 1NP1220 
K1NP1230 
K1NP1240 
KINP125u 
KINP1260 
K IN P 1270 
KIN  PI  280 
K 1NP 1 29u 
K 1NP1300 
K1NP1310 
K INP1320 
K INP1330 
K INP1340 
K1NP1350 
K1NP1360 
KINP1370 
K IN  PI  380 
KINP1390 
K 1NP1400 
K INP141C 
K1NP1420 
KIN  PI  430 
K INP1440 
KINP1450 
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MXTB1  = Jl-1 

KINP1510 

RETURN 

KINP1520 

END 

KINP1530 
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SUBROUTINE  OUTPUT(IJK) 

REV  12 

CONTROLS  TABULATED  OUTPUT  ON  FORTRAN  UNITS  (STARTING  WITH 
OF  SELECTED  OPTIONAL  SEGMENT  LINEAR  AND  ANGULAR  ACCELERATIONS. 
VELOCITIES  AND  DISPLACEMENTS » JOINT  PARAMETERS  AND  SELECTED  DATA 
FRUM  ALL  ALLOWED  CONTACT  FORCE  COMPUTATIONS  BETWEEN  BODY  SEGMENTS 
AND  VEHICLE  COMPONENTS. 


IMPLICIT  REAL*8  (A-H.O-I) 

COMMON/CONTRL/NSEG.N JNT ,NS3,NJ3,NPL,NBLT,NBAG,NVEH,NGRND,NPRT(40) 
CUMMON/JB ARTZ/  MNPL(  20)»MNBLT(  8),MNSEG(  22).MNBAG(  6), 

* MPL(3.5.20),MBLT(3.5.8),MSEG(3» 5.22) , MBAG ( 3. 10 .6 ) , 

* NTPL(5»20)»NTBLT(5»8),NTSEG(5»22) 

COMMON/SGMNTS/D( 3.3.22) ,WMEG(3,22 ) ,WMEGD( 3,22) ,U1 ( 3, 22 ) ,U2 ( 3, 22 ) 

* ,SEGLP(3.22) .SEGLV(3,22),SEGLA(3.22).NSYM(22) 
COMMON/DESCRP/  PHI ( 3, 22 ) ,W (22 ) ,SR ( 3,42 ) »HA ( 3 ,42 ) »HB ( 3, 42 ) 

* ,HT(3,3,42),RPHI(3,22),RW( 22) , SPRING ( 5, 63 ) 

* , VISC ( 7,63 ),JNT( 21 ) ,IPIN (2 1 ) ,NS , ISING(22 ) 
COMMON/CNSNTS/  PI.  RADI  AN, G, THIRD, EPS1 , E PSA, EPS6, EPS8 , 


OUT P001C 
12/17/740UT P002G 
NO.  21)  OUT P0030 
OUT Pu 040 
OUTPC05G 
OUT  P0C60 
OUT  P*iG70 
OUT  PC080 
OUT  P0090 
OUT Po 100 
0UTP0110 
OUT  P0120 
OUTPG130 
OUT  PC 140 
OUT PO 150 
0UTP016V, 
OUT P0170 
OUT P0180 
OUT PO 190 


* EPS12 ,EPS15 ,E  PS20, E PS24, UN ITL ,UNITM ,UN I TT , GRAVTY ( 3)0UTP0200 

COMMON/ VPOSTN/  T IME , X0( 3 ) , XD0T0(3 ) ,XCOMP ( 3) , XVCOMP (3 ) , AX( 3 ) , 0UTPG210 

* ANGLE ( 3 ) , VMPH, VT1ME,ATAB(15,1G0),ATC,ADT  , OMEGA , 0UTP022C 

* NATAB , NACLR, DVEH ( 3, 3 ) , VMEG( 3) , VMEGD ( 3) ,X  ACOMP ( 3 ) , 0UTP023C 

* THET ( 3 ) ,ZPLT (3 ) 0UTP024C 

COMMON/FORCES/PSF (7,20) , BSF ( 4, 2C ) , SSF(  10,20) ,BAGSF(3,20) , 0UTPC250 

* NPSF.NfaSF , NSSF »NBGSF,NPANEL( 6 ) .PRJNT (6 ,2 1 ) 0UTP0260 

COMMON /TEMP VS/  ACC ( 6,20 ) ,T 1 ( 3) ,T2 ( 3 ) ,T3(  3 ) ,T4( 3)  0UTP027O 

COMMON/RSAVE/  XSG( 3 , 20, 3 ), NSG( 7) ,MSG( 20 , 7 ) 0UTP028C 

DATA  LINES/O/, LPP/45/  OUTPC290 

OUT  P0300 

IF  (IJK.NE.O)  GO  TO  9 0UTP0310 


SET  ALL  FORCE  ARRAYS  TO  ZERO. 

DO  8 1=1,480 

8 PSF(I,1)  = 0.0 
DO  7 J=  1,  N JNT 
PRJNT ( 1 ,J ) = 1.0 
PR JNT ( 2 , J ) = 1.0 

IF  (IABS(IPINIJ) ) . E0.4)  PRJNT(l.J)  =0.0 
IF  (IABS(IPIN(  J)).Ei).4)  PRJNT(2,J)  = 0.0 
PRJNT (3»J)  = 0.0 
PRJNT ( 4, J ) = 0.0 
PRJNT ( 5 , J ) = 0.0 
7 PRJNT ( 6 ,J ) = 0.0 
RETURN 

9 CALL  ELTIME (1,8) 

INCREMENT  LINE  COUNT  AND  TEST  FOR  START  OF  NEW  PAGE  ON  EACH  UNIT. 


OUT  P0320 
OUT  PQ330 
0UTP0340 
OUT P0350 
OUT  P036C 
OUT  P0370 
OUT  P0380 
0UTP039C 
0UTP0400 
OUT Pu41G 
OUT  P0420 
0UTP0430 
OUTP0440 
OUT  PC450 
0UTPO460 
OUT  P0470 
DUTP0480 
0UTP0490 
OUT PO 500 
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LINES  = L I NES  + 1 

IF  (MOD(LINES,LPP).NE.l  ) GO  TO  51 
CALL  HEDING(LINES,LPP,MPSF,MBSF,MSSF) 

PRINT  LINE  OF  DATA  FOR  THIS  TIME  POINT  ON  EACH  OUTPUT  UNIT  (NT). 

51  USEC  = 1000 .G*TIME 
NT  = 2C 

COMPUTE  AND  PRINT  DATA  FOR  7 TYPES  OF  OUTPUT  ABOVE 
DO  68  K=1 , 7 

IF  (NSG(K).LE.O)  GO  TO  68 
KSG  = NSG(K) 

J3  = 3 

IF  (K.EQ.7)  J 3 = 2 
DO  67  J 1- 1 « KSG  « J 3 
J2  = MIN0( J1+J3~1,KSG) 

NT  = NT  +1 
DO  66  J=J1,J2 
L = MSG(J,K) 

GO  TO  (52,54,56,59,61,64,65) ,K 

1.  SEGMENT  LINEAR  ACCELERATIONS  IN  LOCAL  REFERENCE 

52  CALL  CROSS  ( WMEG ( 1 , L ) ,XSG( 1 , J, K ) , T 1 ) 

CALL  CROSS  ( WMEG( 1,L),T1,T2) 

CALL  CROSS  ( WMEGD( 1,L) ,XSG(1,J,K),T3) 

CALL  MAT ( D ( 1 , 1 ,L ) , S EGLA ( 1,L) ,14,3,3,1,3,3,3) 

DO  53  1=1,3 

53  ACC  ( I , J ) = (T4(I)+T3(II+T2(I)!/G 
GO  TO  63 

2.  SEGMENT  LINEAR  VELOCITIES  IN  VEHICLE  REFERENCE 

54  CALL  CROSS  ( WMEG ( 1 ,L ) ,XSC( 1 , J, K) , Tl ) 

CALL  DOT(D( 1,1,L),T1,T2,3,1,3) 

DO  55  1=1,3 

55  T3 ( I ) = SEGLV( I ,L ) +T2 ( I ) -XVCOMP ( I ) 

GO  TO  58 

3.  SEGMENT  LINEAR  DISPLACEMENTS  IN  VEHICLE  REFERENCE 

56  CALL  DOT(D( 1,1, L ),XSG(1,J,K) ,T1,3,1,3) 

DO  57  1=1,3 

57  T3 ( I ) = SEGLP ( I , L ) +T 1 ( I ) -XCOMP ( I ) 

50  CALL  MAT  ( DVEH ,T3 , ACC ( 1 , J ) , 3 ,3 , 1 ,3 ,3 ,6 ) 

GO  TO  63 


OUT  Pw510 
OUT  PG 52  0 
OUT  P053G 
OUT  PC  540 
OUT  P0550 
OUT  P0560 
0UTPC570 
OUT  PC  580 
OUT  PC59C 
OUT  P0600 
OUTP06 10 
OUTPu620 
OUT  P0630 
OUT  PG64C 
OUT  Pw»  650 
OUT  P0660 
OUT  P0670 
OUT  PG68u 
0UTP0o90 
OUT  P0700 
OUT  PC  7lu 
OUT  PG720 
OUT  PC  730 
0UTPG74G 
OUT  PG75G 
OUT  PG760 
0UTPG770 
OUT  PC  760 
OUTPG79C 
OUTPC8CO 
OUT PC 8 1C 
OUT  P0820 
OUT  P083G 
OUT PG840 
OUT  PG850 
0UTP086G 
OUT  PG87G 
OUTP088C 
0UTP0890 
OUT  PG900 
0UTP091G 
OUT  PG920 
OUT  PG93C 
OUT  P094C 
OUT  PG95u 
OUT P0960 
OUT  PG97G 
OUT  P098G 
OUT  PG990 
OUTP1000 
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4.  SEGMENT  ANGULAR  ACCELERATIONS  IN  LOCAL  REFERENCE 

59  00  60  1=1,3 

60  ACC(ItJ)  = WMEGD( I , L )/( 2 .0*P I ) 

GO  TO  63 

5.  SEGMENT  ANGULAR  VELOCITIES  IN  VEHICLE  REFERENCE 

61  CALL  DOT  ( 0 ( I , I,L ) , WMEG ( I,L) ,T 1,3 , X ,3) 

CALL  MAT  (0VEH,TI,T2,3,3,I,3,3,3) 

00  62  1=1,3 

62  ACC  ( I , J ) = <T2(I)-VMEG(I))/(2.0*PI) 

63  ACC ( 4, J ) = OSQRT(ACC(I, J )**2 +ACC < 2 , J )**2 +ACC ( 3 , J ) **2 ) 
GO  TO  66 

6*  SEGMENT  ANGULAR  DISPLACEMENTS  IN  VEHICLE  REFERENCE 


64  CALL  DOIT  ( 0( 1 , 1,L ) ,0VEH ,T1, 3, 3,3 ) 
CALL  YPRDEG CT I, ACC ( I , J ) ) 

TRACE  = 0.5*<T1(1)*T2I2)+T3(3)-1.Q) 
IF  ( TRACE • GT • 1.0)  TRACE  = 1.0 

IF  (TRACE. LT.-l.C ) TRACE  = -1.0 
ACC ( 4 , J ) = OARCOS(TRACE )/RAD IAN 
GO  TO  66 

7.  JOINT  PARAMETERS 


65 


66 

12  1 

67 
123 

68 


ACC ( 1 , J ) = 
ACC ( 2 , J ) = 
ACC  ( 3 , J ) = 
ACC ( 4, J ) = 
ACC  ( 5 , J ) = 
ACC  ( 6 , J ) = 
CONTINUE 
IF  (K.LE.6) 


PRJNT(1, D/RADIAN 
PRJNT ( 2 » L )/R ADI AN 
PR JNT ( 3 , L ) 

PRJNT ( 4, L ) 

PRJNT  ( 5 ,L  ) 

PRJNT ( 6 , L ) 


USEC,< ( ACC (I , J),I=1,4) , J=J1,J2) 


WRITE  (NT, 121) 

FORM  AT ( F9. 3 ,3 ( 3X ,4F9 .2 ) ) 

IF  (K.EQ.7)  WRITE  (NT, 123)  USEC, ( ( ACC ( I , J ) , I =1 , 6) , J= 
FORMAT ( F9.3 ,2 ( 2X, 0P2F7.2 , 1P4D1 1 .4)  ) 

CONTINUE 


J1,J2) 


PRINT  PLANE  FORCES 

IF  (MPSF.EQ.O)  GO  TO  77 
DO  76  J 1=1 , MPSF ,2 
J2  = MINO< J1+1,MPSF) 

NT  = NT+1 

76  WRITE  (NT, 129)  USEC  , ( ( PS  F(  I , J ) , 1 = 1 , 7 ) , J = J 1 , J2  ) 
129  FORMAT (F9.3,2( F9.3,3F9.2,3F8.2 ) ) 

PRINT  BELT  FORCES 


OUTPIOIO 
OUT  PI  020 
OUT  P1030 
OUT  P1040 
QUTP1C5G 
OUT  P1060 
OUT  PI  070 
GUT  P1080 
0UTP109C 
OUT  PI  100 
0UTP1110 
0UTP112G 
0UTP1130 
OUTP1140 
0UTPU50 
OUT  PI  160 
OUT  P 1 170 
0UTP118G 
OUT  PI 190 
OUT  PI 200 
0UTP1210 
OUT  Pi 220 
OUTP1230 
0UTP124G 
OUTP125C 
0UTP126C 
OUT  P1270 
OUT  PI 280 
OUT P 129 C 
OUT  P1300 
QUTP131G 
0UTP1320 
0UTP133U 
0UTP1340 
OUT  P135G 
0UTP1360 
OUT  P137G 
OUT  PI  380 
OUTP1390 
0UTP1400 
OUT  P 1410 
OUT  P1420 
0UTP1430 
OUT  P 1440 
OUTP1450 
0UTP1460 
0UTP147C 
0UTP1480 
OUT  P149G 
OUT  P1500 
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77  IF  ( MB  SF*  EQ *0 ) GO  TO  79 
DO  78  J 1=1 , MB  $ F * 2 

J 2 = MINO( Jl+ItMBSF) 

NT  = NT+1 

78  WRITE  (NT, 135)  USEC , ( ( BSF( I , J ) , 1=1 ,4 ) , J = J1 , J2 ) 
135  FORMAT (F9#3,4(F15*6,F12  • 2, 3X ) ) 

PRINT  SEGMENT  CONTACT  FORCES 

79  IF  (MSSF.EQ.O)  GO  TO  81 
DO  80  J=1,M$SF 

NT  = NT  + 1 

80  WRITE  (NT, 37)  US  EC , ( SSF ( I, J ) , I =1 , 10) 

37  FORMAT (2F9.3,3F9«2,3F8*2,2X,3F8«2 ) 

PRINT  AIRBAG  FORCES 

81  IF  (NBAG.EQ.O)  GO  TO  91 
K1  = 1 

DO  83  J = 1 , NBAG 
IF  (MN6AG(  J ).EQ.C)  GO  TO  83 
KBAG  = MNBAGi J )+NPANEL( J )+5 
DO  82  J 1-1 , KBAG, 4 
J2  - M I NO (J1+3,KBAG) 

K2  = K1+J2-J1 
NT  = NT+1 

WRITE  (NT, 21)  U$EC,( (BAGSF(I,K), 1=1,3), K=K1,K2) 
21  FORMAT (F9.3,4(3X,3F9. 2)  ) 

82  K1  = K2+1 

83  CONTINUE 
91  CONTINUE 

CALL  ELTIM  E ( 2 , 8 ) 

RETURN 

END 


0UTP15 lu 
OUT  PI 520 
OUT  P 153i> 
OUT  PI  540 
OUT  PI  550 
0UTP156C 
OUT  PI 570 
0UTP158C 
OUTP159C 
OUT  P160C 
OUT  P 16 10 
OUT  P1620 
OUT  PI 630 
OUT  P 1640 
OUT  P 1 650 
OUT  P1660 
OUT  P1670 
OUT  Pi 680 
OUT  P1690 
OUT  P 1700 
OUT  P17 10 
0UTP172C 
uUT  PI  730 
0UTP1740 
OUT  P17  50 
OUT  PI  760 
OUT  P177C 
0UTP178C 
UUT  Pi  790 
OUTP1800 
OUT  PI  8 10 
OUTP1820 
0UTP1830 
0 UT  P 1840 
OUT  PI  850 
OUT  P 1860 
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SUBROUTINE  PLELP ( MfMM fN , NN ,NT ) 

COMPUTES  FORCES  (WHICH  ARE  ADDED  TO  U1  ARRAY) 
AND  TORQUES  (WHICH  ARE  ADDED  TO  U2  ARRAY) 

OF  ELLIPSOID  (MM)  ATTACHED  TO  BODY  SEGMENT  (M) 
INTERSECTING  PLANE  (NN)  ATTACHED  TO  SEGMENT  (N ) , 


IMPLICIT  REAL  *8(A-H,0-Z) 

COMMON/TAB L ES/MXNT I ,MXNT B, MXTB 1 ,MXTB2 , NT  I (50) ,NTAB (500 ) fT AB ( 2000 ) 
C0MM0N/SGMNTS/D(3t3t 22) t WMEG(3,22 ) ,WMEGD ( 3 , 22 ) ,U1 ( 3, 22 ) ,U2(3,22) 

* t S EGLP ( 3 1 22) ,$EGLV(3,22),SEGLA(3,22) ,NSYM(22) 
COMMON/FORCES/PSF ( 7 ,20)  , BSF( 4, 20) » SSF( 10,20)  ,B AGSF ( 3 ,20 ) , 

* NPSFfNBSF,NSSF,NBGSF,NPANEL(6) ,PRJNT(6,21) 
COMMON/CNT  SRF/  PL ( 17 , 20  ) ,GAB (8,3) * BELT ( 20,8 ) ,TPTS(6,8) ,BD(24,25) 
C0MM0N/CSTRNT/A13(3,3,24) ,A23(3,3,24) ,831(3,3,24) ,B32( 3,3,24) 

* ,HHT ( 3 , 3, 1 2 ) , RK 1( 3 , 12 ) , RK2 ( 3 , 12 ) , QQ( 3 , 12 ) ,TQQ ( 3 , 12 ) 

* , RQQ (3,12) , HQQ ( 3, 12) ,SQQ( 12 ),CFQQ( 12) 

* ,NQ ,KQ1 ( 12 ) ,KQ2 ( 12 ) , KQTYPE ( 12 ) 

COMMON/T  EMPVS/DMNT (3, 3), TEMP (3, 3), B(3, 3), XMN ( 3 ) ,R  LN( 3 ) ,XMM(3) , 


PLEL0010 
REV  12  11/25/74PLELGG2C 
PLELQ030 
PLEL0040 
PLEL0050 
P LELG06G 
PLEL0070 
PLELOOBO 
PLELG090 
PLEL010C 
PLEL0110 
PLEL0120 
PLEL0130 
PLEL014G 
PLEL0150 
PLEL016G 
PLEL017C 
PLELG1BC 
P LE  LG 190 


* TM ( 3) , R (3 ) ,RM ( 3) ,DMNWN (3 ) , RLM ( 3 ) , RN ( 3 ) , VMN ( 3 ) , VR ( 3 ) , P LE LC 200 

* WMN ( 3 ) ,WCM (3 ) ,WCN(3 ) ,VREL ( 3) , FFM(3) , FR ( 3 ) , TQM ( 3 ) , PLEL021G 

* TQN ( 3 ) ,TQNT(3) ,T(3),H(3),T1(3) ,T2(3 ) ,RMD (3) ,RND(3) , PLEL0220 

* TD(3) ,TT4(3,4) ,TT5(3,4) ,T3 (3) ,T4(3) ,P,AMR,FM,CF,  PLELG230 

* VRT,VRTS,TF,MCF,NCF  PLEL0240 

CALL  EL  TIM  E (1,21 ) PLEL0250 


COMPUTE  PENETRATION  DISTANCE,  IF  NEGATIVE,  RETURN. 

CALL  DOTT (D(1,1,M),D(1, 1,N),DMNT,3,3,3) 

DO  10  1=1,3 

10  XMN ( I ) = SEGLPCltM)  - SEGLP(1,N) 

CALL  MAT(U( 1,1 ,M) , XMN , X MM, 3 , 3 , 1,3, 3, 3) 

CALL  MAT ( DMNT ,PL(1,NN),TM,3,3, 1,3, 3, 3) 

BET  = PL ( 4, NN ) 

DO  11  1=1,3 

11  BET  = BET  - TM(I)*(BD(I+3,MM)+XMM(I )) 

CALL  MAT(BD(16,MM),TM,RM,3,3,1,3,3,3) 

BTS  = TM( 1 )*RM ( 1 ) ♦ TM(2)*RM(2)  ♦ TM(3)*RM(3) 

BTE  = -DSQRT(BTS) 

P = BET  - BTE 
MCF  = NTAB(NT+1) 

NCF  = -MCF 

IF  (NCF.GT.O)  CFQQ(NCF)  = -999. 

IF  (P.LE.O.O)  GO  TO  99 

IF  COMPLETE  PENETRATION,  RETURN 

IF  (BET+8TE.GT  .0.0)  GO  TO  99 

COMPUTE  TG  - THE  POINT  IN  SEGMENT  REFERENCE  AT  WHICH  THE  CONTACT 


PLELG260 
PLEL027G 
P LELG280 
P LEL0290 
P LEL0300 
PLELG310 
PLEL032C 
PLEL0330 
PLELG340 
PLEL0350 
PLEL0360 
PLELG370 
PLEL0360 
P LE  LO  390 
PLEL04G0 
PLELG410 
PLELO420 
PLELG43G 
PLEL0440 
PLELG45G 
PLELG460 
PLEL047G 
PLEL0480 
PLE LG490 
P LEL0500 
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FORCES  ARE  TO  BE  APPLIED  WHICH  LIES  ON  THE 
LINE  BETWEEN  THE  POINT  OF  MAXIMUM  PEN ETRATI 
AND  THE  CENTER  OF  THE  INTERSECTION  ELLIPSE  (RH0=1). 
AND  TEMP  - THE  SAME  POINT  IN  VEHICLE  REFERENCE. 

RHO  = 0.0 

IF  (MCF.GT.O)  RHO  = TAB(MCF  + 4) 

BE  TE  = (1.0+RH0*P/BTE)/BTE 
AMR  = -1.0/BTE 
DO  13  1=1,3 
RM ( I ) = BETE*RM( I ) 

RLM(I)  = RM ( I ) + BD  ( 1 + 3 , MM  ) 

13  RN ( I ) = RLM( I ) + XMM ( I ) 

CALL  DOT ( DMNT » RN  , RLN ,3 , 1 ,3  ) 

IF  BOUNDARY  PLANE  IS  GIVEN,  COMPUTE  DISTANCE  FROM  POINT  TO  PLANE, 
IF  NEGATIVE  OR  > LIMIT,  RETURN. 

DO  14  1=8,13,5 

IF  (PL(  I+*t » NN  ) .LE.C.O)  GO  TO  14 
DIST  = RLN ( 1 )*  PL ( I ,NN ) 

♦ + RLN( 2 ) ♦PL ( I ♦ 1 » NN  ) 

* + RLN(3)*PL( 1 + 2, NN)  - PL(I+3,NN) 

IF  (DIST. LE. 0.0  .OR.  DIST.GT.PL(I+4fNN) ) GO  TO  99 

14  CONTINUE 

CALL  PLSEGF (M , N, NT  ) 

IF  (MCF.LT .0)  GO  TO  30 

STORE  RESULTS  FOR  OUTPUT  ROUTINE. 

PS  F ( 1 ,NPSF  ) = P 
PS F ( 2 , NPSF  ) = FM 
PSF ( 3 , NPSF ) = FM*CF 

IF  (VRT.EQ.1.0)  PSF ( 3,N  PSF ) = FM*CF*VRTS 
PS  F ( 4 , NPSF ) = TF 


24 


30 


31 


RLN ( I ) 


T ( I ) 
RLN ( I ) 


32 


DO  24  1=1,3 
PSF ( I +4, NPSF) 

GO  TO  99 
PSF ( 1 , NPSF ) = 

DO  31  1=1,3 
PS  F ( I + 1 »NP  SF) 

PS  F ( 1+4, NPSF) 

CALL  CROSS (WMN»TM,T1 ) 

CALL  MAT ( BD ( 16  »MM ) ,T 1 ,T 2 ,3 , 3 , 1 , 3 , 3 , 3 ) 

TMT  = TM(1)*T2C1I  + TM(2)*T2(2)  + TM(3)*T2<3) 
TMT  = TMT/BTE 
DO  32  1=1,3 

RMD(I)  = (T2( I )-TMT*RM( I ))*BETE 
CALL  CROSS ( DMN  WN,VREL,T1) 

CALL  CROSS ( WMN  »RMD,T3) 


SCALED  PLEL05 10 
ON  ( RHG=  0)PLEL0  52C 
PLELC530 
PLEL054C 
PLELG550 
PLELG56C 
PLEL0570 
PLEL0580 
P LE  LO  590 
PLEL06CC 
PLEL0610 
PLELC62G 
PLEL0630 
PLEL0640 
PLEL065C 
PLEL066G 
PLEL0670 
PLEL0680 
PLELU690 
PLEL07C0 
PLEL071C 
PLEL0720 
PLEL073C 
PLEL0  74C 
P LELG75G 
PLEL076O 
PLEL0770 
PLEL0780 
PLEL0790 
P LEL08C0 
PLEL0810 
PLELC82C 
PLEL063C 
PLEL0840 
PLEL085G 
PLEL086C 
PLELO870 
PLEL0880 
P LEL069C 
PLELC90C 
PLEL0910 
PLEL0920 
P LELC93G 
PLEL0940 
PLELG950 
P LEL096G 
PLEL0970 
PLEL098C 
PLEL099G 
P LEL100G 
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CALL  LOT ( D ( lvlvM) vT3«RQQ(lfNCF)y3vl«3) 
SQQ(NCF)  = 0.0 
DO  36  1=1,3 

36  SQQ(NCF)  = SQQ(NCF)  ♦ TM (I )*<T3< I )+2.0*Tl< I ) ) 
99  CALL  ELTIME (2,21) 

RETURN 

END 


PLE  LI  CIO 
PLEL1020 
P LE  LI 030 
PLEL1G40 
PLEL1050 
PLEL1C60 
P LEL1C70 
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C 5 


SUBROUTINE  RS  TART  ( I F , IT  ) 

REV  12  12/19/ 

THE  FIVE  FUNCTIONS  OF  SUBROUTINE  RSTART  ARE: 

1.  READ  INPUT  £ INITIALIZATION  RECORD  FROM  OLD  RESTART  TAPE. 

2.  WRITE  INPUT  £ INITIALIZATION  RECLRD  UNTO  NEW  RESTART  TAPE. 

3.  READ  TIME  POINT  RECORD  FROM  OLD  RESTART  TAPE. 

4.  READ  NEW  INPUT  DATA  FROM  INPUT  STREAM  FOR  RESTART. 

5.  WRITE  TIME  POINT  RECORD  ONTO  NEW  RESTART  TAPE. 

IMPLICIT  REAL*8(  A-H,0-Z) 

ALL  LABELED  COMMON  BLOCKS  ARE  INCLUDED  HERE 
TO  GIVE  A COMPLETE  SET  FUR  REFERENCE 

COMMON/CONTRL/NSEGt NJNT  fNS3» NJ3,NPL,NBLT , NB A G, NVE H ,NGR ND , NPRT (40 
DIMENSION  I C 1 ( 49  ) 

EQUIVALENCE  ( I C 1 ( 1 ) , NSE G ) 

COMMON/CNTSRF/  PL ( 17,20) ,GAB ( 8 ,3 ) , 8 ELT ( 2C , 8 ) , T PTS ( 6, B) ,BD ( 24 , 25 ) 
DIMENSION  RC2 ( 1172) 

EQUIVALENCE  ( RC2 ( 1 ) , PL ( 1 , 1 ) ) 

COMMON/ VPOSTN/  T 1ME , XO ( 3 ) , XDOTO (3 ) , XCOMP ( 3 ) , XVCOMP ( 3 ) , AX ( 3 ) , 

♦ ANGLE (3 ) , VMPH, VTIME, ATAB( 13,100)  , ATO  , ADT  , OMEGA, 

♦ NATAB ,NACLR,DVEH(3,3),VMEG(3),VMEGD(3),XAC0MP(3), 

♦ THET  ( 3 ) , ZPLT  ( 3 ) 

DIMENSION  RC3 ( 1B27 ) , RC3  A (1 51 1 ) , 1C3 ( 2 ) ,RC3B ( 1 8 ) 

EQUIVALENCE  ( RC3 ( 1 ) ,TIME  ) , ( R C3 A { 1 ) , AX ( 1 ) ) , 

♦ (1C3(1), NATAB) , ( RC3B( 1 ) , DVEH (1,1 )) 

COMMON/SGMNTS/D( 3,3,22) ,WMEG(3,22) ,WMEGD(3,22) , U1 ( 3, 22 ) , U2 ( 3 , 22 ) 

♦ ,SEGLP(3,22),SEGLV(3,22),SEGLA ( 3 , 22 ) ,NS YM ( 22 ) 
DIMENSION  RC4 ( 660 ) 

EQUIVALENCE  ( RC4 ( 1 ) , D ( 1 , 1, 1 ) ) 

COMMON /CM A TRX/ VI (3,21),V2(3,21),V3(3,12),B12 (3 , 3 , 42 ) , A22 ( 3 , 3 , 42 ) 

♦ ,F ( 3 , 2 1 ) , TQ( 3 , 21 ),WJ(2l) 

DIMENSION  RCBA(918),RC5B(147) 

EQUIVALENCE  ( RC5 A( 1 ),V1( 1,1) ), (RC5B(1),F(1,1 )) 

COMMON  /ABDATA/  ABC(3,5),  ZA(3,5),  DA(3,3,5),  BFA(3,5) 

♦ ,BCGV(3,5),BMEG(3,5) 

DIMENSION  RC6 ( 120 ) 

EQUIVALENCE  ( RC6 ( 1 ) , ABC ( 1 , 1 ) ) 

COMMON/TITLES/  DAT E ( 3 ) , C GHENT ( 40 ) t VPSTT L ( 20 ) ,B  DYTT  L ( 5 ) , BLTTTL ( 5 , 

♦ ,PLTTL(5,20) ,BAGTTL(5,6),SEG(22) ,JUINT(21 ) 

♦ ,CGS  ( 2 1 ) , JS(  21  ) 

REAL  DATE , COM ENT ,VPSTTL, BDYT  TLtBLTTTL,PLTTL,BAGTTL,SEG, JOINT 
LOGICAL*!  CGS , JS 


RSTA0010 
74RSTA002C 
RSTA003G 
RST A004C 
RSTAOCBG 
RSTA0060 
RSTA0G7C 
RST ACG8C 
RST  AO 090 
RST  AO  100 
R ST  AO  1 1 0 
R ST  AO  120 
RSTAG13C 
RST  AO  140 
R STAG  1 BC 
RST  AO  160 
RST A017C 
R ST  AG  1 80 
R ST  AO  190 
RST  AC20C 
RSTA0210 
RSTAG220 
RSTA0230 
RST  A0240 
RSTAG2B0 
RSTA0260 
KSTA0270 
RSTAC2BG 
RSTA0290 
RSTA0300 
RSTAG31C 
RST A0320 
RSTA0330 
RSTA0340 
RSTA03B0 
RSTAC360 
RST  A0370 
RSTA038G 
RSTA0390 
RSTA0400 
RSTA0410 
RSTA0420 
RSTA0430 
RSTA044C 
RSTA0450 
8 ) R ST  A046C 
RSTA0470 
RSTA0480 
RSTA0490 
R ST  AC  BOO 
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C 8 
C 9 

C 10 

C 11 

C 12 
C 13 

C 14 
C 15 

C 16 


REAL  RC7fRC7AfXDTEfXCMENT 

DIMENSION  RC7 (238) ,RC7A ( 28 1 ) ,XDTE ( 3) *XCMENT ( 40 ) 
EQUIVALENCE  ( RC7 ( 1 ) , VPS TTL ( 1 ) ) , (RC7A(1)  , DATE  ( 1 ) ) 


COMMON /CNSNTS/  Pit  R ADI  AN, G, TH IRD , EPS1 , E PS4 f EPS6f EPS8 , 

* EPSl2,EPS15fEPS20,EP$24tUNITL  tUN ITM ,UN  I TT tGRAVT Y ( 3 
DIMENSION  RC8 ( 18  ) 

EQUIVALENCE  (RC8(1),PI) 

COMMON/D ESCRP/  PHI (3 ,22)  ,W (22 ) ,SR ( 3,42 ) , HA ( 3 ,42 ) , HB ( 3 , 42 ) 

* tHT ( 3 1 3 «42 ) t RPHI (3 , 22 ) ,RW ( 22 ) , SPRING(5 ,63) 

* ,VISC(7,63),JNT(21) , I PIN ( 2 1 ) ,NS,IS1NG(22 ) 

* , IGL08 (21 ) ,JUINTF(21 ) 

DIMENSION  RC9( 1688) , IC9 ( 10 7) 

EQUIVALENCE  (RC9(1),PHI (1,1)), ( IC 9 ( 1 ) , JNT ( 1 ) ) 

C0MM0N/J8 ARTZ/  MNPL(  20),MN8LT(  8),MNSEG(  22),MN8AG(  6), 

* MPL(3,5,20),M8LT(3,5,8) ,MSEG(3 ,5,22) , MBAG ( 3 , ID, 6 ) , 

* NTPL( 5,20),NT8LT(5,8) ,NTSEG(5 ,22 ) 

DIMENSION  IC10 ( 1236 ) 

EQUIVALENCE  ( IC10(1) »MNPL( 1) ) 

COMMON /FOR CES/PSF (7,20) *BSF(4,20),SSF(1Q,2G ) ,BAGSF(3,20) , 

* NPSF,NBSF ,NSSF ,NBGSF ,NPAN  EL ( 6 ) , PR JNT (6,2 1) 

DIMENSION  RC1 1(480) t IC1 1(4), RC 11 A( 126) 

EQUIVALENCE  (RC1K1)  ,PSF(  1,1))  ,(IC  11(1),  NPSF), 

* ( RC1 1 A ( 1) , PR JNT ( 1,1) ) 

COMMON/INTEST/  SGTEST( 3 ,4, 22 ) , XTEST( 3,88 ) 

DIMENSION  RC12 ( 528 ) 

EQUIVALENCE  ( RC12 ( 1 ) , SGTEST(  1,1,1)  ) 

COMMON/CSTRNT/ A13 (3, 3, 24), A2 3(3, 3, 24), 831(3, 3, 24) ,b32( 3,3,24) 

* , HHT (3,3,12),RK1( 3, 12 > ,RK2 ( 3 , 1 2 ) , QQ (3 , 12 ) ,TQQ(3,12) 

* , RQQ ( 3 , 12 ) ,HQQ(3,12), SQQ (12 ),CFQQ(12) 

* , NQ , KQ 1(12) ,KU2 (12) ,KQTYPE ( 12) 

DIMENSION  RC13 ( 72 ) , IC13 ( 37 ) , RC 13 A( 1212 ), RC13H( 348 ) 

EQUIVALENCE  (RC13(1) ,RK 1(1,1) ) , ( IC 13 ( 1 ) , NQ ) , ( RC 13 A ( 1 ) , A13 ( 1 , 1 , 1 ) ) 

* ,(RC13H( 1) ,HHT( 1,1,1) ) 

COMMON /TA8L  ES/MXNT I,MXNTB,MXT81,MXT82,NTI(50 ) ,NTA8(500 ) f TAB (2CG0 ) 
DIMENSION  IC14 ( 554) 

EQUIVALENCE  ( IC14(1 ),MXNTI ) 

COMMON/COM A IN/ VAR ( 120 ),DER( 120) ,DT ,HC,HMAX,HMIN,RSTIME, 

* ISTEP,NSTEPS,NDINT,NEQ,IRS IN , IR  SOUT 
DIMENSION  RC15  ( 245)  , IC15  (6  ) 

EQUIVALENCE  ( RC 1 5 ( 1 ) , V AR ( 1 ) ) , ( IC15 ( 1 ) , I STEP ) 

COMMON/CDINT/  E( 3, 120 ) , FF( 5 , 120) ,GG( 5 , 1 20 ) , Y (5 , 120 ) ,U ( 5, 120) 


RSTA0510 
RSTA0520 
RSTA053C 
R ST  AC  5 40 
RSTAC550 
) R ST  AO 560 
RSTA0570 
R ST  AC  580 
RSTAC590 
R ST  A0  6C0 
RSTA0610 
R ST At  620 
RSTA0630 
RSTAO640 
RSTA065C 
RSTAC66G 
RSTAC670 
RSTA0680 
RSTAC690 
RSTA0700 
RSTA0710 
RSTA072C 
R ST  AO 730 
RSTAG740 
RSTA075G 
R ST  A076C 
RSTA0770 
RSTA0780 
RSTA0790 
RSTAC8G0 
RSTAG81G 
RSTAG820 
RSTA0830 
R ST  AC  840 
R ST  AO 8 50 
RSTAG86C 
RSTAG87G 
RSTA0880 
R ST  AO  890 
RSTA0900 
RSTA0910 
R ST  AG 920 
RSTA0930 
RSTAC940 
R ST  AO  950 
R ST  AO  960 
RS7  A097C 
RSTAG98G 
RSTAG990 
RSTA100C 
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c 

C 17 

C 18 

C 19 
C 20 


C 21 


C 22 


C 23 


* ,H,HPRINT»TSAVE,TPRINT  tTSTART  tlCNT  , IDBL, I FLAG 

NOTE:  FF  REPLACES  F FROM  SUBROUTINE  DINT. 

DIMENSION  RC 16(2765) t IC 16( 3 ) 

EQUIVALENCE  ( RC16( 1 ) , E ( 1 ,1 ) ) , ( IC 16 ( 1 ) , 1 CNT ) 

COMMON/DAMP ER/APSOM( 3, 20), APSON( 3,2G), ASD(5t  20) , 

* NS0tMSDM(2C)*MS0N(20) 

DIMENSION  RC17(220) ,1C17(41) 

EQUIVALENCE  ( RC17(  1 ) , AP  SDM  ( 1 ,1  ) ) , ( IC17(  1 ) ,NSO) 

COMMON/CEULER/  I EULER ( 22  )#H1R<  3, 3# 21 ) , ANG( 3 , 21 ) , ANGO( 3 ,21 ) , 

* FE ( 3 » 21 ) «TQE(3«21) t CUNST (3*21) 

DIMENSION  RC1 8 ( 504) 

EQUIVALENCE  ( RC18 ( 1 ) ,HI R ( 1 , 1 , 1 ) ) 

COMMON/TEMP VI/  TT 1 ( 3 ) , R 1 1 ( 3 ) ,R2I ( 3 ) ,CRES T , J S TOP ( 4 , 2 ,2 1 ) 
DIMENSION  RCI9(I0)t IC19( 168) 

EQUIVALENCE  ( RC19 ( 1 ) * TT I { 1 ) ) , ( IC 1 9 ( 1 ) , JS TOP ( 1,1,1)) 


COMMON  /WJONES/ 

* FORCE ( 3, 5) , T OR  A( 3, 5 ) ,XBM ( 5 ) , ZOEP ( 3 , 5 ) ,VBA6G( 5) ,VSCS (5) 

* BPHI (3, 5) ,DBR(3,3,5),DPVCTR( 3,5 ) ,DEPL0Y(3, 5) , AB ( 3,5 ) , SPRK ( 5 ) , 

* CYT D ( 5 ) ,CYPA( 5),CYSP(5) ,CYTO(  5), 

* CY VO ( 5) , CY C 0 ( 5 ) , CYK ( 5) , CYR(5),  CYAT(5),  CYPV(5),  CYCD0(5), 

* CYAO ( 5) , CYPG(  5 ) , CYSS(5),  CYL0(5),  CYC(5),  CYRHOO ( 5 ) , CYVMAX ( 5 

* CY0RFC(5) ,CYRH0(5) , CYT (5 ) , CYP ( 5 ) , CYMIN ( 5 ) , CYMOUT ( 5 ) , 

* BAGPV(5) ,PD(5 ) ,VBAG( 5) ,VOLBP( 5 ) ,SW ITCH( 5 ) , 1 FULL ( 6 ) , 

* TMP( 18) ,TMP1( 3),A( 3, 3) , P F ( 3 ) , T ORQ ( 3 ) , 

* TQB( 3,10) ,FRB(3, 10 ) , VOL ( 10 ) , OE LF ( 3 ) , 

* B(9,4,5),ZB(3,4,5) ,ZR( 3,4,5 >,BFB( 9,4,5 ) ,DRR( 9,4,5 ) , 

* OB ( 9,4,5) ,PCGV( 3,4,5) , PM EG ( 3 ,4, 5 ) , VOL P ( 4 , 5 ) , FRA ( 3 ,4 ) , PR EVT 

* , CK ( 5 ) , CMASS ( 5 ) 

DIMENSION  RC20A ( 30 ) ,RC20B( 235) ,RC2GC ( 50 ) , RC2 00 ( 109 ) ,RC 20E ( 1B0 ) , 

* RC20F(60) ,RC2wG(420) , RC 2CH ( 320 ) ,RC 20 1 ( 10 ) 

EQUIVALENCE  (RC20A(  1 ) ,FORC  E(  1,  1 ) ) , ( RC2  OB  ( 1 ) , XBM  ( 1 ) ), 

* ( RC20C ( 1 ) ,CY  RHQ ( 1 ) ) , (RC200 ( 1 ) , TMP ( 1 ) ) , 

* (RC20E( 1),B< 1,1,1) ) , (RC20F( 1) , ZB (1,1,1) ) , 

* (RC20G( 1) ,ZR(1,1,1) ) , (RC2 OH (1),D8 (1,1,1) ), 

* ( RC20I ( 1 ) ,CK (1 ) ) 


COMMON/RSAVE/  XSG (3 , 20, 3 ) , NSG ( 7 ) , MSG (20, 7) 

DIMENSION  RC21C1B0)  ,1C21(147) 

EQUIVALENCE  ( RC2 1 ( 1 ) , XS G ( 1 , 1 , 1 ) ) , ( IC2 1 ( 1 ) , NSG ( 1 ) ) 

COMMON/FLXB LE/  HF( 4,12,8  ), B42 ( 3 ,3 , 24 ) , V4 ( 3, B ) , NFL EX ( 3 , 8 ) ,NFLX 
DIMENSION  RC22(624) , 1C22 (25) 

EQUIVALENCE  (R C2 2(1), HF (1,1,1))  , ( IC22 ( 1 ) , N FL EX ( 1 , 1 ) ) 

COMMON /HRN ESS/  6AR(6,100)  , XL0NG(2G)  , IBAR(2,1Q0)  , NTHRNS ( 20 ) 
* NHRNSS  , NBLTPH(5)  , NFNBL(5,20)  , NPTSPB(20) 


RSTA101C 
RSTA1020 
RSTA1030 
RSTA1C40 
RSTA1U50 
RSTA1060 
RSTA1070 
RSTA1080 
RSTA1090 
RSTAllUO 
RSTA1110 
RSTA112G 
RSTA1130 
RSTA1 140 
RSTA1150 
RSTA116G 
RSTA1170 
RSTA118C 
RST  A119G 
RSTA1200 
, R STA 12 10 
RSTA122G 
RSTA123G 
RST  A1 240 
),RSTA125G 
RSTA126G 
RSTA127G 
RSTA128G 
RSTA1290 
RSTA1300 
RST  A1 310 
RSTA1320 
RSTA1330 
RSTA1340 
RSTA135G 
RSTA1360 
RST A137G 
RSTA1380 
RSTA1390 
RST A14C0 
RSTA141C 
RSTA1420 
RST A143G 
RSTA144C 
RSTA145G 
RST A1460 
RSTA147C 
RSTA14B0 
, R ST  A1 490 
RSTA1500 
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ooo  0 0.0  ooo 


DIMENSION  RC23 ( 620 ) , IC231346) 
EQUIVALENCE  ( RC23 ( 1 ) , BAR  ( 1 , 1 ) ) , 


C 24 


COMMON/KALE  PS/  WTIME ( 30 ) ,1 WI ND (30 ) 
DIMENSION  RC24  ( 30 ) , IC24(1^0) 
EQUIVALENCE  ( RC24( 1 ) , WT IME ( 1 ) ) , ( 


(IC23(l),IBAR(ltl)) 
t MWSEG ( 5,22 ) 

IC24 ( 1 ) y IW IND( 1 ) ) 


DIMENSION  COMMON ( 24 ) 

DATA  COMMON  /8HC0NTRL 

* 8HCMATRX 

* 6MDESCRP 

* 8HCSTRNT 

* 8HDAMPER 

* 8HRSAVE 

REAL  A0LD4  9 AA0LD4 
DATA  B LANK/8H  / 

dimension  Index ( 3 ) 

CALL  ELTIME ( 1*25) 

GO  TO  ( I00t2O0t3C0t4OO,5CK))tIf: 


1.  READ  INPUT  £ INITIALIZATION  RECORD  FROM  OLD  RESTART  TAPE. 


t 8HCNTSRF 
t 6H  ABDATA 
, 8HJBARTZ 
t 8HT  ABL  ES 
♦8HCEULER 
t 8HFLXB  LE 


9 8HVP0STN 
♦8HTITLES 
♦8HF0RCES 
98HCOMA  IN 
98HTEMPVI 
9 8HHRNESS 


9 8HSGMNT S 
9 8HCNSNTS 
9 8HINTEST 
9 8HCDINT 
9 6HW JUNE  S 
9 8HK ALEPS  / 


( IT)  IC1 9PL9BD9X09XDOTC9RC3A,NATAB92PLT,NSYM9XDTE9XCMENT9 
RC7fCGSf JS9RCfatRC9  9 JNTf IC1G, NPAN E L, SGTEST , RCI 3, IC13f 
IC149DT9HGfHMAX9HMIN9NSTEPS  9NDINT  tRCl7, ICI79IEULER9 
RC2ubf IFULL9RL20E9RC20G,RC20I 9RC2I9 IC2I9NS9 ISING 
fHF 9NFLEX9NFLX9 ICi9fIGLGB,J0INTFfRC239 I C23 , RC24 , IC 24 


100  READ 

* 

* 

* 

* 

WRITE  (69IOI)  IT 9XDTE9XCMENT 

101  FORMAT! fQ  INPUT  DATA  HAS  BEEN  READ  IN  FROM  UNIT  N0.,tI4// 

* IOX9  3A4//10X  9 20A4/1GX,20A4) 

GO  TO  999 

2.  WRITE  INPUT  £ INITIALIZATION  RECORD  ONTO  NEW  RESTART  TAPE. 


200  WRITE  (IT) 
* 

* 

* 

* 

GO  TO  999 


ICl9PL9BD9X0fXDOTO9RC3A,NATAB  f ZP LT , NSYM  ,DAT E tCOM ENT  9 
RC7fCG$9 JS9RC89RC99 JNT , ICIO9NPANEL9  SGTEST,RC13,IC  13, 
IC14,DT9HG9HMAX,HMIN9NSTEPS,NDINT,RC179lCl79lEULER9 
RC2OB9IFULL9  RC2  0E,RC20G9RC201 9RC2I9 IC21 ,NS , ISING 
,HF 9NFLEX9NFLX9lC19,IGLOB, JOINTF9RC239 IC23,RC249 IC24 


3.  READ  TIME  POINT  RECORD  FROM  OLD  RESTART  TAPE. 

300  READ  ( IT)  TIME  9 BELT  9 TPT S, XCOMP, XVCOMP 9 RC3B , RC4,RC5B , R C6, 1 P IN  9 RC 

* 9 1 Cl 1 9 PR JNT, TAB9RCI6,IC169RC20A,RC20C9lFULL ,RC20H,PRE 

* ,RC21, IC21 9VAR9DER 9NEQ,XTfcST ,V4,ICI9,RC13H,KQTYPE 

* ,1EULER,RC23, WTIME, IWIND 
CALL  OUTPUT ( 1 ) 

GO  TO  999 


RSTA151C 
RSTA152C 
RSTA133C 
RSTA1S4G 
RSTA155C 
RSTAI560 
RSTA157C 
RSTA158G 
RSTAI59C 
RSTA1600 
R ST  A 1 610 
RSTA1620 
RSTAI63G 
RST  A1640 
RSTA165C 
RSTA1660 
RSTA1670 
RSTAI680 
RST  A 1690 
RST A1 700 
RST  A1 710 
RSTA1720 
RSTA1730 
RSTA174C 
RSTA1750 
RST  A176C 
RSTA177C 
RSTA178C 
RSTA179C 
RST A180C 
RSTA161G 
RSTAI820 
RST A183G 
RSTA184G 
RSTAI65G 
RSTA1860 
RSTA1870 
RST A188C 
RST A189C 
RSTA1900 
RSTA191G 
RSTA192C 
RSTA1930 
11RSTA1940 
VTRST  A1950 
RSTA196G 
RST  A1 970 
RSTA198G 
RSTA199G 
RSTA2  00G 
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5.  WRITE  TIME  POINT  RECORD  ONTO  NEW  RESTART  TAPE. 

500  WRITE  (IT)  TIME, BELT ,TPT S, XCOMP,XVCOMP , RC3B , RC4 , RC5B , RC6, IPIN 

* ,1 C 11 ,PR JNT, T AB  » RC1 6, IC 16 ,RC  20A, R C20C  » I FULL ,RC20H , 

* , RC 21,1021, VAR, DER ,NEQ,XTEST , V4, I C 19 ,RC 13H, KUTYPE 

* ,1£ULER,RC23,WTIME, IW1ND 
GO  TO  999 

4.  READ  NEW  INPUT  DATA  FROM  INPUT  STREAM  FOR  RESTART. 

400  READ  (5,401)  AVAR , INDEX , ITYPE , RR , I I , AA , RROLD , I IOLD ,AAOLD 

401  F0RMAT(A8,4I4,2(F8.0,I8,A8) ) 

CALL  SEARCH(AVAR, INDEX, NCOM, ITEM) 

IF  (NCOM.LE.O)  GO  TO  490 

IF  (NCOM. GT. 24)  GO  TO  999 
IF  ( ITYPE. GT. 3)  GO  TO  49C 

GO  TO  ( 1,  2,  3,  4,  5,  6,  7.  8,  9,10,11,12, 

* 13, 14, 15, 16,17,18,19,20,21,22,23,24) ,NCOM 
COMMON  /CONTRL/ 

1 IF  (ITEM.GT.49)  GO  TO  490 

IF  ( ITYPE. NE*2)  GO  TO  490 

IOLD  = IC  1 ( IT  EM ) 

ICl(ITEM)  = II 

GO  TO  494 
COMMON  /CNTSRF/ 

2 IF  (ITEM. GT. 1172) 

IF  (ITYPE. NE.l) 

ROLD  = RC  2 ( IT  EM ) 

RC  2( ITEM)  = RR 
GO  TO  492 
COMMON  /VPOSTN/ 

3 IF  ( ITEM. GT. 1527)  GO  TO  402 
IF  (NTYPE.NE.l) 

ROLD  = RC3 ( ITEM ) 

RC3 ( ITEM)  = RR 
GO  TO  492 

402  IF  ( ITEM. GT. 1529) 

IF  (NTYPE.NE.2) 

IOLD  = IC3( ITEM-1527) 

IC 3( IT  EM— 1527 ) = II 
GO  TO  494 

403  IF  ( ITEM. GT. 1553 ) GO  TO  490 
IF  (NTYPE.NE.l)  GO  TO  A90 
ROLD  = RC3B ( ITEM-1529) 


GO  TO  490 
GO  TO  490 


GO  TO  490 


GO  TO  403 
GO  TO  490 


RC3B (ITEM-1529) 
GO  TO  492 
COMMON  /SGMNTS/ 
IF  (ITEM. GT. 660 
IF  (ITYPE. NE.l) 
ROLD  = RC4 ( IT  EM ) 


RR 


GO  TO  404 
GO  TO  490 


RSTA2010 
RSTA2020 
*RC 1 1R  ST  A2030 
PREVTR  ST  A204C 
RSTA2050 
RSTA206C 
RSTA2070 
RSTA2080 
RST  A2  090 
RSTA2100 
RSTA2110 
RSTA2120 
RST  A2 130 
RSTA2140 
RSTA215C 
RSTA2160 
RSTA2  17G 
RST  A2  180 
RSTA2190 
RSTA2200 
RSTA2210 
RSTA222G 
RSTA2230 
RSTA2240 
RSTA225C 
RSTA2260 
RSTA2270 
RSTA2280 
RSTA229G 
RSTA23C0 
RSTA2310 
RSTA2320 
RST  A2330 
R STA2340 
RSTA2350 
RSTA2360 
RSTA2  370 
RSTA2380 
RSTA2390 
RSTA2400 
RSTA2410 
RSTA2420 
RSTA2430 
RSTA244G 
RSTA2450 
RSTA2460 
RSTA2470 
RSTA248C 
RSTA2490 
RST  A2  500 
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RC4(  ITEM)  = RR 

RSTA25I0 

GO  TO  492 

RSTA252D 

404 

IF  (ITEM. GT. 682  ) 

GO 

TO 

49  0 

RSTA2530 

IF  (ITYPE.NE.I) 

GO 

TO 

490 

RSTA2540 

10  LD  = NSYM (IT  EM- 

660) 

RSTA2550 

NSYM ( ITEM-660)  = 

II 

RSTA2  56G 

GO  TO  494 

RSTA257G 

COMMON  /CMATRX/ 

RSTA2580 

5 

IF  ( ITEM. GT. 1065) 

GO 

TO 

490 

RSTA2590 

IF  (ITYPE.NE.I) 

GO 

TO 

49  C 

RSTA2600 

ROLL)  = RC5  A ( I T EM  ) 

RSTA2610 

RC5  A( ITEM)  = RR 

RSTA2620 

GO  TO  492 

RSTA2630 

COMMON  /ABDATA/ 

RSTA2640 

6 

IF  (ITEM. GT. 120  ) 

GO 

TO 

490 

RSTA265C 

IF  (ITYPE.NE.I) 

GO 

TO 

49  0 

RSTA2660 

ROLD  = RC6 ( ITEM) 

RSTA2670 

RC6( ITEM)  = RR 

RSTA2680 

GO  TO  492 

RSTA2690 

COMMON  /TITLES/  NOTE: 

NO  PROVISION  FOR  CGS  OR  JS. 

RSTA2700 

7 

IF  (ITEM. GT. 281  ) 

GO 

TO 

490 

RSTA271C 

IF  (ITYPE.NE.3) 

GO 

TO 

490 

RSTA272G 

AOLO  = RC7A ( ITEM ) 

RSTA2730 

RC7A( ITEM)  = AA 

RSTA2740 

GO  TO  496 

RSTA2750 

COMMON  /CNSNTS/ 

RSTA276G 

8 

IF  (ITEM. GT. 15  ) 

GO 

TO 

408 

RSTA2770 

IF  (ITEM. LE. 12  ) 

GO 

TO 

408 

RSTA2780 

IF  (ITYPE.NE.3) 

GO 

TO 

490 

RSTA2  790 

AOLD  = RC8 ( ITEM) 

RSTA280C 

RC8 ( ITEM)  = AA 

RSTA28IG 

GO  TO  496 

RSTA2820 

408 

IF  (ITYPE.NE.I) 

GO 

TO 

490 

RSTA2830 

ROLD  = RCti( ITEM) 

R STA284G 

RC  8 ( ITEM)  = RR 

RSTA265G 

GO  TO  492 

RSTA2860 

COMMON  /DESCRP/ 

RSTA287U 

9 

IF  ( ITEM. GT. 1688 ) 

GO 

TO 

409 

RSTA2880 

IF  (ITYPE.NE.I) 

GO 

TO 

490 

RSTA289C 

ROLD  = RC9 ( ITEM) 

RSTA290G 

RC 9 ( ITEM)  - RR 

RSTA29I0 

GO  TO  492 

RSTA2920 

409 

IF  ( ITEM. GT. 1795) 

GO 

TO 

4Q0 

RSTA2930 

IF  ( I TYPE. N E. 2 ) 

GO 

TO 

49  u 

RSTA294G 

IOLO  = IC9( ITEM-1688) 

RSTA295G 

IC9( ITEM-1688 > = 

II 

RSTA2960 

GO  TO  494 

R STA297C 

COMMON  /JB ART  Z/ 

RSTA298C 

10 

IF  ( ITEM. GT. 1236) 

GO 

TO 

490 

RSTA299G 

IF  (ITYPE.NE.2) 

GO 

TO 

49  0 

RSTA30CG 

128 


10LD  = ICIO(ITEM) 

RSTA301C 

IC I C ( 11  EM ) = II 

RSTA3020 

GO  10  *.9*. 

RSTA3030 

c 

COMMON  /FORCES/ 

RSTA3040 

11 

IF  ( I TEM.GT  .960  GO 

TO 

411 

RSTA3050 

IF  (NTYPE.NE.l)  GO 

TO 

490 

RST  A3060 

ROLO  = RCll(ITEM) 

RSTA3070 

RCU<  ITEM)  = RR 

RSTA3080 

GO  TO  A 92 

RSTA3090 

All 

IF  ( ITEM.GT.A90)  GO 

TO 

AI2 

RST  A3 100 

IF  (NTYPE.NE.2)  GO 

TO 

49  0 

RST  A3  110 

10  LD  = 1C1 1 ( I TEM-A80 ) 

RSTA3120 

IC  1 1 ( ITLM-A80  ) = II 

RST  A3 130 

GO  TO  A9A 

R ST A3 140 

412 

IF  ( ITEM.GT.616)  GO 

TO 

49  C 

RST  A3 150 

IF  (NTYPE.NE.l)  GO 

TO 

490 

RST  A3  160 

ROLD  = RC11A( ITEM— A9C) 

R ST  A3 170 

RC 1 1 A ( ITEM-490 ) = RR 

RST  A3180 

GO  TO  492 

RST  A3  190 

c 

COMMON  /INTEST/ 

RSTA3200 

12 

IF  (IT  EM.GT  *528  ) GO 

TO 

490 

RST  A3  21 0 

IF  (ITYPE.NE^I)  GO 

TO 

490 

RSTA3220 

ROLD  = RC1 2 ( IT  EM  ) 

RSTA3230 

RC12( ITEM)  * RR 

RSTA3240 

GO  TO  492 

RSTA3250 

c 

COMMON  /CSTRNT/ 

RST  A326C 

13 

IF  ( ITEM*GT*1212 ) GO 

TO 

413 

RSTA327G 

IF  ( 1TYPE*N  E*  1 ) GO 

TO 

490 

RSTA3280 

ROLD  = RC1 3A ( I TEM ) 

RSTA3290 

RC 13 A ( ITEM)  = RR 

RSTA3300 

GO  TO  492 

RSTA331G 

413 

IF  ( ITEM.GT.1249)  GO 

TO 

490 

RSTA332G 

IF  (ITYPE.NE.2)  GO 

TO 

490 

RSTA3330 

10LD  = IC1 3 ( I T EM— 1212) 

RSTA3340 

1C  13 ( ITEM-1212)  = II 

RSTA3350 

GO  TO  A9A 

RSTA3360 

c 

common  /tables/ 

RSTA337G 

1 A 

IF  (ITbM.GT.55A  ) GO 

TO 

41 4 

RSTA3380 

IF  (ITYPE.NE.2)  GO 

TO 

490 

RSTA3390 

IOLD  = ICIA(ITEM) 

RSTA3400 

ICIA(ITEM)  = II 

RSTA3410 

GO  TO  A9A 

RST  A3 420 

A1A 

IF  ( ITEM.GT.255A)  GO 

TO 

490 

RSTA3430 

IF  (ITYPE.NE.l)  GO 

TO 

490 

RSTA3440 

ROLD  = TAB ( IT  EM-55A ) 

RST  A3 450 

TAB ( ITEM— 55A)  = RR 

RST A3 460 

GO  TO  A92 

RST  A3470 

c 

COMMON  /COMAIN/ 

RSTA3480 

15 

IF  (ITEM.GT.2A5  ) GO 

TO 

415 

RSTA3490 

IF  (ITYPE.NE.l)  GO 

TO 

490 

RSTA3500 

129 


ROLD  = RC 15 ( I TEM ) 

RSTA3510 

RC 15 ( ITEM)  = RR 

RSTA3520 

GO  TO  492 

RSTA3530 

415 

IF  (ITEM. GT. 251  ) GO 

TO 

490 

R ST  A3  540 

IF  (1TYPE.NE.2)  GO 

TO 

49  L 

RSTA3550 

IOLD  = 1C1 5 ( I T EM— 245 ) 

RSTA356C 

IC 15 ( ITEM-245 ) = II 

RSTA3570 

GO  TO  494 

RSTA3580 

c 

COMMON  /CD I NT  / 

RSTA3590 

16 

IF  (ITEM. GT. 2765)  GO 

TO 

416 

RSTA3600 

IF  ( ITYPE.N  E. 1 ) GO 

TO 

490 

RSTA3610 

ROLD  = RC1 6 ( I TEM ) 

RST  A3620 

RC  16  ( ITEM)  = RR 

RSTA3630 

GO  TO  492 

RSTA3640 

416 

IF  (ITEM. GT. 2768)  GO 

TO 

490 

RSTA3650 

IF  ( ITYPE.NE.2)  GO 

TO 

49  0 

RSTA3660 

IOLD  = IC16( ITEM-2765) 

R$TA367o 

IC 16 ( I T EM-2765 ) = 11 

RSTA368G 

GO  TO  494 

RST  A3690 

c 

COMMON  /DAMPER/ 

RSTA370G 

17 

IF  (ITEM. GT. 220  ) GO 

TO 

417 

RSTA3710 

IF  (1TYPE.NE.1)  GO 

TO 

490 

RST  A3  720 

ROLD  = RC 17 ( IT  EM ) 

RSTA373C 

RC17( ITEM)  = RR 

RST A3 740 

GO  TO  492 

RSTA3750 

417 

IF  (ITEM. GT. 261  ) GO 

TO 

49  C 

RST  A376i/ 

IF  (ITYPE.NE.2)  GO 

TO 

490 

RST  A3  770 

IOLD  = IC17 ( ITEM-220 ) 

RST  A3  780 

IC 17 ( IT  EM-220 ) = II 

RSTA3790 

GO  TO  494 

RSTA38C0 

c 

COMMON  /CEULER/ 

RSTA3810 

18 

IF  (ITEM. GT. 22  ) GO 

TO 

418 

RSTA382C 

IF  (ITYPE.NE.2)  GO 

TO 

490 

RSTA3830 

IOLD  = IEUL  ER ( ITEM) 

RST  A3  840 

IEULER(ITEM)  = 11 

RSTA3850 

GO  TO  494 

R ST  A3 6 60 

418 

IF  (ITEM. GT. 526  ) GO 

TO 

49  0 

RSTA387G 

IF  ( 1 TYPE • N E. 1 ) GO 

TO 

490 

RSTA388C 

ROLD  s RC18 ( ITEM— 22 ) 

RSTA3690 

RC 18 ( 1 TEM— 22 ) = RR 

RSTA3900 

GO  TO  492 

RSTA391G 

c 

COMMON  /TEMPVI/ 

RSTA392U 

19 

IF  (ITEM.GT.1G  ) GO 

TO 

419 

RSTA3930 

IF  (1TYPE.NE.1)  GO 

TO 

49  C 

RSTA394C 

ROLD  = RC 19 ( ITEM ) 

RSTA3950 

RC 19( ITEM)  = RR 

RSTA3960 

GO  TO  492 

RSTA397G 

419 

IF  (ITEM. GT. 178  ) GO 

TO 

49  C 

R ST  A3  980 

IF  (ITYPE.NE.2)  GO 

TO 

49  C 

RSTA3990 

IOLD  = 1C 1 9 ( 1 T EM- 1C ) 

RST  A4C00 

130 


c 

20 


420 


320 


C 

21 


421 


C 

22 


422 


C 

23 


42  3 


IC  16  ( 1 T EM— 10)  = II 
GO  TO  494 
COMMON  /WJONES/ 

IF  ( I T EM.GT *3  15  ) GO  TO  42  0 
IF  UTYPE.NE.l)  GO  TO  490 

ROLD  = RC20A( ITEM) 

RC  20A ( ITEM ) = RR 
GO  TO  492 

IF  ( ITEM. GT. 321  ) GO  TO  320 
IF  (ITYPE.NE.2)  GO  TO  490 

IQLD  = IFULU  ITEM-315) 
IFULL(  ITEM-315)  II 
GO  TO  494 

IF  (ITEM. GT. 1433)  GO  TO  490 
IF  ( ITYPE.NE.l ) GO  TO  49C 
ROLO  = RC200( ITEM-321) 

RC  200 ( IIEM-32 1 ) = RR 
GO  TO  492 
COMMON  /RSAVE/ 

IF  (ITEM. GT. 180  ) GO  TO  421 
IF  (ITYPE.NE.l  ) GO  TO  490 
ROLO  = RC2KITEM) 

RC21(  ITEM)  * RR 
GO  TO  492 

IF  ( ITEM. GT. 327  ) GO  TO  490 
IF  (ITYPE.NE.2  ) GO  TO  490 
IQLD  * IC2 1 ( I TEM— 180 ) 

IC2 1 ( IT  CM— lbO ) = II 
GO  TO  494 
COMMON  /FLXBLE/ 

IF  (ITEM.GT.624  ) GO  TO  422 
IF  (ITYPE.NE.l  ) GO  TO  49U 
ROLO  * RC22 ( I TEM ) 

RC22 ( ITEM)  = RR 
GO  TO  492 

IF  (ITEM.GT.649  ) GO  TO  490 
IF  (ITYPE.NE.2  ) GO  TO  490 
IOLD  = IC22 ( I T EM-62 4 ) 

IC22( ITEM-624)  = II 
GO  TO  494 
CO MM ON /HRN ESS/ 

IF  (ITEM.GT.620  ) GO  TO  423 
IF  (ITYPE.NE.l)  GO  TO  490 
ROLO  * RC23 (ITEM) 

RC23( ITEM)  = RR 
GO  TO  492 

IF  (ITEM. GT. 966  ) GO  TO  490 
IF  (ITYPE.NE.2)  GO  TO  490 
IOLO  = IC23 ( ITEM-620 ) 

IC23( ITEM-620)  = II 


RSTA4C10 
RSTA4020 
RSTA4U30 
RSTA4C40 
RSTA4050 
RSTA4060 
RSTA4070 
RSTA4G8G 
RSTA4090 
RSTA4100 
RSTA4110 
RSTA4120 
RSTA4130 
RSTA4140 
RSTA4150 
RSTA4160 
RSTA4170 
RSTA4180 
RSTA4190 
RSTA4200 
RSTA4210 
RSTA4220 
R STA4230 
RSTA4240 
R ST  A4250 
RSTA426G 
RSTA4270 
RSTA428G 
RSTA4290 
RSTA4300 
RSTA4310 
RSTA4320 
R ST A4330 
R ST  A434C 
RSTA4350 
RSTA4360 
RSTA437G 
RSTA4380 
RSTA4390 
RSTA4400 
RSTA4410 
RSTA4420 
RSTA443C 
RSTA444G 
RSTA4460 
RSTA446U 
RSTA447G 
RSTA448C 
RSTA4490 
RSTA450C 
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GO  TO  494 

C COMMON/KALEPS/ 

24  IF  (ITEM.GT.30  ) GO  TO  424 
IF  (ITYPE.NE.l)  GO  TO  490 
ROLD  = RC24 ( ITEM) 

RC24 ( ITEM)  = RR 
GO  TO  492 

424  IF  (ITEM.GT.17G  ) GO  TO  490 
IF  (ITYPE.NE.2)  GO  TO  490 
IOLD  = IC24 ( I TEM— 30  ) 

IC24(  ITEM-30  ) *=  II 
GO  TO  494 

ERROR  MESSAGE  - TERMINATE  PROGRAM. 

49C  WRITE  (6,491)  AVAR , INDEX ,NCOM, ITEM , ITYPE ,RR , I I , AA 

491  FORMAT ( *0  SUBROUTINE  RS TART  INPUT  ERROR*// 

* • AVAR*  • ,A8,  *INDEX=*  ,316,  • NCOM**, 16,*  ITEM-  • , 16, 

* • ITYPE** , 16 , • RR=*,G15.8,»  11  = *, 18,*  A A*  * ,A8// 

* • program  is  BEING  TERMINATED.*) 

STOP 

PRINT  MESSAGE  FOR  REAL  VARIABLES. 

492  WRITE  (6,493)  AVAR , INDEX  ,COMMON( NCOM ), ROLD, RR 

493  FORMATC *0* ,A6, •( *tl4, *,  * ,1 4, * , * , 14 , • ) OF  COMMON/* , A6, •/• , 

* • HAS  BEEN  CHANGED  FROM  *,G15.8,*  TO  *,G15.8) 

IF  ( RROLD. EQ. 0.0)  GO  TO  400 

IF  ( DABS( RROLD— ROLD ) .LE • 0. uOOO 1*RR  OLD)  GO  TO  400 
WRITE  (6,383)  RROLD 

383  FORMAT  (•  INPUT  VALUE  FOR  RROLD  WAS  *,G15.8//) 

GO  TO  490 

PRINT  MESSAGE  FOR  INTEGER  VARIABLES. 

494  WRITE  (6,495)  AVAR , I NDE X ,COMMON( NC OM ) , 1 0 LD , 1 1 

495  FORMAT ( *0* , A6 , * ( • , 14, * , * ,14,*, • , 14 , • ) OF  COMMON/* , A6, »/» , 

* * HAS  SEEN  CHANGED  FROM  *,  18,*  TO  *,  18) 

IF  ( 1 1 OLD • EQ. 0 ) GO  TO  400 
IF  ( IOLD. EQ. HOLD)  GO  TO  400 
WRITE  (6,385)  HOLD 

385  FORMA T ( • INPUT  VALUE  FOR  HOLD  WAS  *,I8//) 

GO  TO  490 

PRINT  MESSAGE  FOR  ALPHANUMERIC  VARIABLES. 

496  WRITE  (6,497)  AV AR , INDEX , COMMON ( NCOM ), AOLD, A A 

497  FORMAT (*0* ,A6, •( • , 14, • , *,I4, *, • , 14, • ) OF  COMMON/* , A6, •/• , 

* • HAS  BEEN  CHANGED  FROM  *,  A8,*  TO  *,  A8) 

IF  ( A AOLD • EQ. BLANK ) GO  TO  400 


RSTA451C 
RSTA452G 
RSTA4530 
RSTA4540 
RSTA*5BG 
RSTA4  560 
RSTA457U 
RSTA4580 
RSTA459C 
RSTA4600 
R ST A4610 
RSTA4620 
RSTA4630 
RST  A4640 
RSTA4650 
RSTA4660 
RSTA46  7u 
RSTA468C 
RSTA469C 
RSTA4700 
RSTA4710 
R STA4720 
RST  A473C 
RSTA4740 
RSTA4750 
RSTA4760 
RSTA477C 
RSTA478G 
RSTA4790 
RSTA4B00 
RSTA4810 
RSTA4820 
RSTA483C 
RSTA4840 
RSTA4650 
RSTA4860 
RSTA4870 
RSTA488C 
RSTA489G 
RSTA4900 
RSTA491C 
RSTA4920 
RSTA493C 
RSTA4940 
R STA49BG 
RSTA4960 
RSTA4970 
RSTA498G 
RSTA4990 
RSTA5000 
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AA0LD4  = AAOLO 
AOLD4  = A OLD 

IF  (A0LD4.EQ.AA0LD4)  GO  TO  400 
WRITE  (6,387)  AAOLO 

387  FORMAT ( • INPUT  VALUE  FOR  AAOLO  WAS  *,A8//) 
GO  TO  49C 

999  CALL  ELTIME (2,25) 

RETURN 

END 


RSTA6010 
RST  A5  u2G 
RST  Ai>030 
RSTA5040 
RSTA5G60 
RSTA3060 
RST  A5G7G 
RSTA5080 
RSTAS090 
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SUBROUTINE  SEARCH! AVAR , INDEX ,NCOM , ITEM ) 


SEAR0010 
REV  12  12/19/74S  EAR0020 


CALLED  BY  SUBROUTINE  RSTART  TD  COMPUTE  NCOM  L ITEM  FROM  AVAR  L 
INDEX.  RETURNS  NCDM=0  FOR  ERROR  AND  NCDM=50  FDR  BLANK. 

IMPLICIT  REAL*8( A-H,0-Z) 

DIMENSION  BVAR(300) , KDUNT(25), NDIM ( 3,300 ) ,N J ( 3 ) ,NK(3) , INDEX! 3) 
DATA  N VAR/2 77/ , KOM/24/ 

DATA  KOUNT/  If  lit  16f  37,  46,  54,  60,  71,  87,103,114,124,126, 

* 143,150, 163, 176,182,189,194,258,261,266,274,278/ 

DATA  BLANK/8H  / 

1 CDMMON/CDNTRL/ 

DIMENSION  Cl  ( 

EQUIVALENCE  (Cl 
DATA  Cl  / 8HNSEG 

* 8HNBLT 

DATA  NCI  / 0,0,0 

* 0 , C, 0 

2 CDMMDN/CNT  SRF/ 


10)  , NCI  ( 30) 

( 1 ) , BVAR ( 1))  , (NCI  (1),NDIM(1, 


,8H  N JN1 
, 8HNBAG 
, 0,0,0 
t 0,0,0 


♦8HNS3 

,8HNVEH 

t 
♦ 


0,0,0 

0,0,0 


, 8HN J3 
,8HNGRND 

t 0,0,0 

, 0,0,0 


1 ) ) 

, 8HNPL 
, 8HNPRT 
♦ 0,0,0 


40,0,0 


DIMENSION  C2  ( 
EQUIVALENCE  (C2 
DATA  C2  / 8HPL 
DATA  NC2  / 17,20,0 

3 COMMON/VPD  STN/ 


5)  , NC2  ( 15) 

( 1 ) , 8VAR  ( ID)  , 
, 8H  GAB 
8,3,0 


, ( NC2  ( 1 ) ,ND  IM  ( 1 , ID) 

,8HBELT  , 8HTPTS  , 8HBD 

, 20,8,0  , 6,8,0  , 24,25,0 


DIMENSION  C3  ( 21) 


NC3  ( 63) 


S EARC030 
SEAR0040 
SEAR0050 
SEAR0060 
SEAR0070 
SEAR0080 
SEAR0C9G 
SEAR0100 
SEARO110 
SEAR0120 
SEAR0130 
SEAR0140 
SEAR0150 
SEAR0160 
S EAR0170 
SEAR0180 
SEARO 190 
SEAR0200 
SEAR021C 
SEAR0220 
SEAR023G 
S EAR0240 
SEAR0250 
SEAR0260 
S EAR027C 
SEARO  280 
S EAR0290 
SEAR0300 
SEAR0310 


EQUIVALENCE  (C3  (1) 

, BVAR ( 16)) 

, ( NC3  ( 1 ) 

,ND IM ( 1 , 16)) 

SEAR032G 

DATA 

C3  / 8HTIME 

,8HXC 

, 8HXDQT  0 

, 8HXCDMP 

, 8HXVC0MP 

t 

S EARG33G 

* 

8HAX 

,8H ANGLE 

,8HVMPH 

, 8HVTIME 

, 8HATA8 

, 

SEAR0340 

* 

8HATC 

, 8H  A DT 

,8H OMEGA 

, 8HNATAB 

, 8HNAC  LR 

t 

S EAR0350 

* 

8 HD V EH 

,8H VMEG 

, 8HVMEGD 

, 8HX ACOMP 

, 8HTHET 

, 

SEARG360 

* 

8HZPLT 

/ 

SEARG370 

DATA 

NC3  / 0,0,0 

t 3,0,0 

, 3,0,0 

, 3,0,0 

, 3,0,0 

, 

S EAR0380 

♦ 

3,0,0 

t 3,0,0 

, 0,0,0 

, 0,0,0 

, 15,100 

fO, 

SEAR0390 

♦ 

0,0,0 

, 0,0,0 

, 0,0, 0 

, 0,0,0 

, 0,0,0 

t 

SEAR0400 

* 

3,3,0 

t 3,0,0 

, 3,0,0 

, 3,0,0 

t 3,0,0 

t 

SEAR0410 

♦ 

3,0,0 

/ 

SEARO 420 

CDMMDN/SGMNTS/ 

DIMENSION  C4  ( 9)  , NC4  ( 27) 

EQUIVALENCE  (C4  CD, BVAR!  37))  , ( NC4  (1),NDIM(1,  37)) 

DATA  C4  / 8 HD  ,8H WMEG  , 8HWMEGD  ,8HU1  , 8HU2 

* 8HSEGLP  , 8HS  EGLV  ,8hSEGLA  ,8HNSYM  / 

DATA  NC4  / 3,3,22  , 3,22,0  , 3,22,0  , 3,22,0  , 3,22,0 


SEAR0430 
SEAR0440 
S EAR0450 
SEAR0460 
SEAR0470 
S EAR0480 
SEAR0490 
S EAR0500 
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3,22,0 

, 3 ,22  , C 

, 3,22,0 

, 22,0,0 

/ 

SEARC510 

SEAR0520 

COMM ON/CM A TRX/ 

SEAR053C 
$ EARG540 

DIMENSION  C 5 ( 8) 

, NC5  ( 24) 

SEAR0550 

EQUIVALENCE  (C5  (I) 

« BVAR  ( 46)) 

, (NC5  (1) 

,ND 1M ( 1 , 46)) 

S EAR0560 

DATA  C5  / 8HV I 

,8HV2 

,8HV3 

, 8HB  12 

, 8HA22 

* 

SEAR6570 

8HF 

»8HT  0 

, 8HWJ 

/ 

SEAR0580 

DATA  NC5  / 3,21,0 

. 3,21,0 

t 3,12,0 

, 3,3,42 

, 3,3,42 

t 

SEA  RO  590 

3,21,0 

, 3,21,0 

, 21,0,0 

/ 

SEAR060C 

SEAR0610 

C0MM0N/ABDATA/ 

SEAR0620 

SEAR0630 

DIMENSION  C6  ( 6) 

, NC6  ( 18) 

SEAR0640 

EQUIVALENCE  (C6  (I) 

, BVAR ( 54)) 

, ( NC6  ( 1 ) 

, ND 1M ( 1 , 34)) 

SEAR0650 

DATA  C6  / 8HABC 

, 6H  Z A 

, 8HDA 

, 8HBFA 

, 8HBCGV 

« 

SEAR0660 

8HBMEG 

/ 

S EAR0670 

DATA  NC6  / 3,5,0 

, 3,5,0 

, 3,3,5 

, 3,5,0 

. 3,5,0 

, 

SEAR068G 

3,5,0 

/ 

S EAR069C 
SEAR0700 

COMMON/TITLES/ 

SEAR071i/ 

SEARU720 

DIMENSION  C7  ( 11) 

, NC  7 ( 33) 

S EAR073C 

EQUIVALENCE  <C7  (1) 

, B VA R ( 60)) 

, (NC7  (1) 

, ND  1M  ( 1 , 60) 

SEAR0740 

DATA  C7  / 8 HD ATE 

,8HC0MENT 

,8H  VPSTT  L 

.8HBDYTTL 

, 8HBLTTT  L 

, 

SEAR0750 

8HPLTTL 

, 6HB AGTTL 

, 8HSEG 

.8HJ0INT 

, 6HCGS 

f 

SEAR0760 

8HJS 

/ 

SEAR0770 

DATA  NC7  / 3,0,0 

, 40,0,0 

, 20,0,0 

• 5,0,0 

, 5,8,0 

f 

SEAR078G 

5,20,0 

, 5 ,6 , 0 

, 22,0,0 

, 21,0,0 

, 22,0,0 

t 

SEAR0790 

21,0,0 

/ 

SEARu800 

SEAR0810 

C0MM0N/CNSNTS/ 

S EAR0820 
SEARC63C 

DIMENSION  C8  ( 16) 

, NC8  ( 48) 

S EAR084C 

EQUIVALENCE  (C8  (1) 

, B VAR ( 71)) 

, ( NC8  ( 1 ) 

, ND IM ( 1 , 71)) 

SEAR0850 

DATA  C8  / 8HPI 

,8HR  ADIAN 

, 8 HG 

, 8HTH1RD 

, 8HEPS1 

, 

SEAR0860 

8HEPS4 

, 8HE  PS6 

,8HtPS8 

»8HEPS12 

, SHfcPS  15 

t 

S EAR0870 

8HEPS20 

, 6H E PS24 

, 8HUN IT  L 

, 8HUN1TM 

, 8HUN1 TT 

, 

SEAR0680 

8HGRAVTY 

/ 

SEAR0890 

DATA  NC8  / 0,C,0 

, 0,0,0 

, 0,0,0 

, 0,0,0 

, 0,0,0 

* 

S EAR0900 

0,0,0 

, u,0,0 

, 0,0,0 

, 0,0,0 

, 0,0,0 

, 

SEAR091G 

0,0,0 

, OtOfO 

, 0,0,0 

, 0,0,0 

, 0,0,0 

t 

S EA RO  920 

3,0,0 

/ 

S EAR0930 
SEAR0940 

COMMON/DESCRP/ 

SEARG950 

SEAR096C 

DIMENSION  C9  ( 16) 

, NC9  ( 48) 

S E ARC  970 

EQUIVALENCE  <C9  (1) 

, BVAR ( 87)) 

, ( NC9  (1) 

, ND IM ( 1 , 87)) 

SEAR0980 

DATA  C9  / 8HPHI 

, 8H  W 

, 8H  SR 

, 8HHA 

, 8HHB 

, 

SEAR0990 

8HHT 

, 8H  R PH  I 

»8HRW 

,8HSPR1NG 

, 8H V I SC 

t 

SEAR1000 
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* 8HJNT 

, 8H  I PI  N 

« 8HNS 

,8H1SING 

, 8H1GL0B 

f 

SEAR1010 

* 8HJ0INTF 

/ 

S EAR 1020 

DATA  NC9  / 3 * 22*  0 

t 22,0,0 

. 3,42,0 

, 3,42,0 

, 3,42,0 

t 

SEAR1030 

* 3,3,42 

, 3,22,0 

, 22,0,0 

, 5,63,0 

, 7,63,0 

t 

S EA  R 1040 

* 21,0,0 

t 21,0,0 

, 0,0,0 

, 22 ,0,0 

, 21,0,0 

* 

SEAR1O50 

* 21,0,0 

/ 

S EAR 1060 

c 

SEAR1070 

c 

10 

C0MM0N/JBARTZ/ 

SEAR1C80 

c 

S EAR 1G90 

DIMENSION  C1C<  11) 

, NC 10 ( 33) 

S EAR 1 100 

EQUIVALENCE  (C10(l) 

, BVAR (1 C3 ) ) 

, ( NC IOC  11 

,NDIM( 1, 103) 

) 

SEAR1UC 

DATA  C1C/  8HMNPL 

, 8HMNBLT 

• 8HMNSEG 

,8HMNBAG 

, 8HMPL 

f 

SEAR1120 

* 8HM8LT 

, 8HMSEG 

,8HMBAG 

,8HNTPL 

, 8HNTBLT 

f 

SEAR1130 

* 8HNTSEG 

/ 

S EAR 1 140 

DATA  NC 10/  20,0,0 

, 8,0,0 

, 22,0,0 

, 6,0,0 

, 3,5,20 

t 

SEAR115C 

* 3,3,8 

t 3,5,22 

, 3 , 10 , 6 

, 5,20,0 

, 5,8,0 

t 

S EAR 1 160 

* 3,22,0 

/ 

SEAR1170 

c 

SEAR1180 

c 

11 

COMMON/FORCES/ 

SEAR1190 

c 

SEAR1200 

DIMENSION  C 11 ( 10) 

, NC  11  ( 30) 

SEAR1210 

EQUIVALENCE  (Cil(l) 

, BVAR (114)) 

, (NC1K1) 

,NDIM( 1, 114) 

) 

SEAR1220 

DATA  Cll/  8HPSF 

, 8HBSF 

, 8HSSF 

, 8HBAGSF 

, 8HNPSF 

t 

SEAR1230 

* 8HNBSF 

, 8H  NSS  F 

, 8HNBGSF 

, 8HNPANEL 

, 8HPRJNT 

/ 

SEAR1240 

DATA  NC11/  7,20,0 

t 4,20,0 

, 10,20,0 

, 3,20,0 

, 0,0,0 

t 

SEAR125W 

* 0,0,0 

, 0,0,0 

, 0,0,0 

, 6,0,0 

, 6,21,0 

/ 

S EAR  1260 

c 

SEAR1270 

c 

12 

COMMON/INTEST/ 

SEAR  1280 

c 

SEAR129G 

DIMENSION  C 12 ( 2) 

, NC  12  ( 

6) 

SEAR130C 

EQUIVALENCE  (C12(l) 

, BVA  R ( 124  ) ) 

, ( NC12 ( 1 ) 

,NDIM(1, 124) 

) 

SEAR131G 

DATA  C 12/  8HSGTEST 

, 8HXTEST 

/ 

SEAR1320 

DATA  NC12/  3,4,22 

, 3,88,0 

/ 

SEAR1330 

c 

S EAR 1340 

c 

13 

COMMON/CSTRNT/ 

SEAR1350 

c 

SEAR136Q 

DIMENSION  C 13 ( 17) 

, NC13(  5 

1) 

S EAR137G 

EQUIVALENCE  ( C 13 ( 1 ) 

, BVAR ( 126  ) ) 

, ( NC13 ( 1 ) 

,NDIM (1,126) 

) 

SEAR1380 

DATA  C 13/  8HA13 

, 8H  A23 

, 8HB31 

, 8HB32 

, 8HHHT 

V 

SEAR1390 

* 8HRK1 

,8HRK2 

» 8HQQ 

,8hTQQ 

, 8HR0Q 

f 

S EA  R 1400 

* 8HHQQ 

, 8HSQQ 

,8HCFQQ 

, 8 HNO 

, 6HKQ1 

f 

S EAR 14 lu 

* 8HKQ2 

, 8HKQTYPE 

/ 

SEAR1420 

DATA  NC13/  3,3,24 

, 3,3,24 

, 3,3,24 

, 3,3,24 

, 3,3,12 

V 

S EA  R 1430 

* 3,12,0 

, 3,12,0 

t 3,12,0 

, 3,12,0 

, 3,12,0 

V 

SEAR1440 

♦ 3,12,0 

, 12,0,0 

t 12,0,0 

, 0,0,0 

, 12,0,0 

f 

SEAR1450 

* 12,0,0 

» 12,0,0 

/ 

S EAR1460 

c 

SEAR1470 

c 

14 

COMMON/TABLES/ 

SEAR1480 

c 

S EAR 1490 

DIMENSION  C 14 ( 7) 

, N C 14  ( 2 

1) 

S EAR  1500 
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EQUIVALENCE  < C 14 < 1 > , 8VAR < 143 ) ) , ( NC14 ( 1 ) ,ND 1M ( 1 , 143 ) ) 


DATA  C 14/  8HMXNTI  ,8HMXNT8  ,8HMXT81 

♦ 8HNTA8  t8HTA8  / 

DATA  NC14/  OtOtO  v 0,0,0  , 0,0,0 

* 500,0,0  , 2000,0,0/ 


,8HMXT82  , 8HNT I 
, 0,0,0  , 50,0,0 


15  C0MM0N/C0MAIN/ 


DIMENSION  C 15  ( 13)  , NC15<  39) 

EQUIVALENCE  ( C 15 ( 1 ) , BVAR (1 50 ) ) 


DATA  C 15/  8HVAR 

* 8HHMIN 

* 8HNEQ 

DATA  NC 15/  120,0,0 

* 0,0,0 

* 0,0,0 


, 8HD  ER 
, 8HRSTIME 
,8H IRS  IN 
, 120,0,0 
, 0,0,0 
, 0,0,0 


<NC15(1),NDIM(1,150>> 


8HDT 

8H1STEP 

8HIRS0UT 

0,0,0 

0,0,0 

0,0,0 


, 8HH0 
» 8HNSTEP  S 
/ 

, 0,0,0 
, 0,0,0 


t 8HHMAX 
r 8HNDI NT 

r 0,0,0 

t 0,0,0 


16  COMMON /CD1NT  / 


DIMENSION  C 16 ( 13) 


NC  16  ( 39) 


EQUIVALENCE  ( C 16 ( 1 ) , 8VAR (1 63 ) ) 
DATA  Cl 6/  8HE 

♦ 8HH 

♦ 8HICNT 

DATA  NC16/  3,120,0 

♦ 0,0,0 

* 0,0,0 


, 8HFF 
, 8HHPR  INT 
» 8N  I DBL 
, 5,120,0 

t 0,0,0 
, 0,0,0 


, ( NC 16 ( 1) , ND  IM ( 1,163) ) 

,8 HOG  , 8HY  , 8HU 

,8HTSAVE  , 8HTPRIN  T , 8HTSTART 

, 8HIFLAG  / 

, 5,120,0  , 5 , 120 ,C  , 5,120,0 

, 0,0,0  , 0,C,0  , 0,0,0 

, 0,0,0  / 


17  COMMON/DAMPER/ 


DIMENSION  C 17 ( 


6)  , NC  17 ( 18) 


EQUIVALENCE  (C 17 ( 1) ,8VAR(176 ))  , (NC17( 1 ) ,NDIM( 1, 176) ) 


DATA  C 17/  8HAPSDM 

* 8HMSDN 

DATA  NC17/  3,20,0 

♦ 20,0,0 


, 8H  A PSDN 
/ 

, 3,20,0 


, 8HASD 


5,20,0 


i 8 HNSD 


0,0,0 


r 8HMSDM 


20,0,0 


18  COMMON/CEULER/ 


DIMENSION  C 18  ( 


7)  , NC  18  ( 21) 


EQUIVALENCE  ( C 18 ( 1 ) , 8VA R (1 82 ) ) , ( NC18 ( 1 ) ,ND  IM ( 1, 182 ) ) 


DATA  C 18/  8HI EULER 

♦ 8HTQE 

DATA  NC  18/  22,0,0 

* 3,21,0 


, 8HH IR 
, 8HC0NST 
t 3,3,21 
, 


3,21,0 


,8H ANG 
/ 

t 3,21,0 
/ 


r 8HANGD 


f 8HFE 


, 3,21,0  , 3,21,0 


19  COMMON/TEM  P VI / 


DIMENSION  C 19  ( 5)  , NC19(  15) 

EQUIVALENCE  (C19( 1 ) , 8 VAR C 189 ) ) , (NC19C1  ) ,NDIM ( 1, 189) ) 


SEAR151C 
, SEAR1520 
SEAR1530 
, SEAR1540 
SEAR1550 
SEAR1560 
SEAR157C 
SEAR1580 
SEAR1590 
SEAR1600 
, S EAR 1 610 
, SEAR1620 
S EAR  1630 
, SEAR1640 
, SEAR1650 
S EAR 1660 
SEAR1670 
SEAR1680 
S EAR1690 
SEAR1700 
S EAR  1710 
, SEAR1720 
, SEAR173G 
SEAR1740 
, SEAR175G 
, SEAR1760 
SEAR1770 
SEAR1780 
SEAR1790 
SEAR1800 
SEAR1810 
SEAR1820 
, SEAR183G 
SEAR1840 
, S EAR  1650 
SEAR1860 
SEAR187C 
SEAR1880 
SEAR1890 
SEAR1900 
SEAR1910 
« SEAR1920 
SEAR1930 
, SEAR1940 
SEAR1950 
SEAR1960 
SEAR1970 
SEAR1980 
SEAR1990 
SEAR200G 
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DATA 

C 19/  8HTT1 

, 8HR 11 

,8HR21 

, 8H0REST 

, 8HJST0P 

/ 

SEAR2010 

DATA 

NC19/  3,0,0 

, 3,0,0 

, 3,0,0 

, C , 0 , C 

, 4,2,21 

/ 

SEAR2020 

SEAR2C30 

COMMON/WJONES/ 

SEAR2C4C 

S EAR2050 

DIMENSION  C20(  64) 

, NC20  ( 192) 

SEAR2C60 

EQUIVALENCE  <C20(1) 

, 8VAR (194) 

) t ( NC20( 1 ) 

,ND1M( 1, 194) ) 

SEAR2070 

DATA 

020/  8HF0RCE 

, 8H  TOR  A 

• 8HX8M 

,8HZDEP 

, 8HV8AGG 

, 

SEAR208G 

♦ 

8HVSCS 

, 8H8  PH  1 

1 8HD8R 

, 8HDPV0TR 

, 8HD  EPLO Y 

, 

SEAR2090 

♦ 

8HAB 

, 8H  SPRK 

»8HCYTD 

, 6H0 YPA 

, 8HCYS  P 

, 

SEAR2100 

♦ 

8HCYT0 

,8H0YVC 

,8HCYCD 

, 8H0YK 

, 8HC YR 

, 

SEAR2110 

* 

8HCYAT 

, 8H  0 YPV 

t 8HCYCD0 

, 8H0 YAG 

, 8HCYP0 

t 

SEAR2120 

* 

8HCYSS 

,8H0 YLO 

t 8HCYC 

, 8H0 YRHOO 

, 6HCYVMAX 

, 

SEAR2130 

♦ 

8HCYORFC 

, 6HCYRH0 

• 8HCYT 

, 8H0YP 

, 8HCYM IN 

, 

SEAR214G 

* 

8HCYM0UT 

, 8H  8 AGP  V 

• 8HPD 

,8HVBAG 

, 8HV0L8P 

, 

SEAR2150 

* 

8HSWITCH 

,8H 1FULL 

1 8HTMP 

, 8H1 MP 1 

, 8H  A 

, 

SEAR2160 

* 

8HPF 

, 8HTORQ 

• 8HTQ8 

, 8HFR8 

, 8HV0L 

, 

SEARcl70 

* 

8HDELF 

, 8H8 

• 8HZ8 

, 8HZR 

, 8HB  F6 

t 

SEAR2180 

♦ 

8HDRR 

, 8HD8 

»8HPCGV 

, 8HPHEG 

, 8HV0LP 

, 

SEAR2190 

♦ 

8HFRA 

,8HPREVT 

t 6HCK 

, 8H0M AS  S 

/ 

SEAR2200 

DATA 

NO  20/  3,5,0 

, 3,5,0 

t 5,0,0 

, 3,5,0 

, 5,0,0 

, 

SEAR221G 

♦ 

5,0,0 

, 3,5,0 

, 3,3,5 

, 3,5,0 

, 3,5,0 

, 

S EAR2220 

♦ 

3,5,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 

S EAR223C 

* 

5,0,0 

, 5,0,0 

. 5,0,0 

, 5,0,0 

t 5,0,0 

, 

SEAR224U 

♦ 

5 , C , C 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 5 , C , 0 

, 

SEAR2250 

♦ 

5,0,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 

SEAR226G 

♦ 

5,0,0 

, 5,0,0 

» 5,0,0 

t 5,0,0 

» 5,0,0 

, 

SEA  R227G 

♦ 

5,0,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 5,0,0 

, 

S EAR2280 

♦ 

5,0,0 

, 6 ,0 , 0 

, 18,0,0 

, 3,0,0 

, 3,3,0 

, 

SEAR2290 

* 

3,0,0 

, 3,0,0 

, 3,10,0 

t 3,10,0 

, 10,0,0 

t 

SEAR2300 

♦ 

3,0,0 

t 9,4,5 

, 3,4,5 

, 3,4,5 

t 9,4,5 

, 

SEAR2310 

♦ 

9,4,5 

, 9,4,5 

, 3,4,5 

, 3,4,5 

, 4,5,0 

, 

SEAR2320 

* 

3,4,0 

, 0,0,0 

, 5,0,0 

, 5,0,0 

/ 

SEAR2330 

SEAR2340 

COMMON/RSAVE/ 

SEAR2350 

SEAR2360 

DIMENSION  C2I  ( 3) 

, NC21 ( 

9) 

SEAR2370 

EQUIVALENCE  (C21(I) 

, BVAR (258 ) 

) , (N021(l) 

,ND IM ( 1 , 2 58 ) 

) 

SEAR2380 

DATA 

021/  8HXSG 

, 8H  NSG 

, 8HMSG 

/ 

SEAR2390 

DATA 

NC21/  3,20,3 

, 7,0,0 

, 20 ,7,0 

/ 

SEAR2400 

SEAR2410 

COMMON/FLXbLE/ 

SEAR2420 

SEAR243C 

DIMENSION  C 22  ( 5) 

, NO 22  ( 

15) 

S EAR2440 

EQUIVALENCE  ( C22 ( 1 ) 

, 8VAR (261 ) 

) , ( N022 ( 1 ) 

t ND 1M ( It  261 ) ) 

S EAR2450 

DATA 

022/  8HHF 

,8HB42 

,8HV4 

, 8HNFLEX 

, 8HNFL  X 

/ 

SEAR2460 

DATA 

NC22/  4,12,8 

, 3,3,24 

, 3,8,0 

, 3,8,0 

, 0,0,0 

/ 

SEAR2470 

SEAR2480 

CO MM ON /HRN ESS/ 

SEAR249G 

DIMENSION  C23 ( 8) 

, NO 23  ( 

24) 

SEAR2500 
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EQUIVALENCE  ( C 23 ( 1 ) , 8V AR ( 266 ) ) 

, ( NC23 ( 1 ) 

,ND IM ( 1,266) ) 

DATA 

C23/  8H8AR  ,8HXL0NG 

, 8H IbAR 

, 8HN1HRNS  , 

8HNHRNSS 

♦ 

8HNBLTPH  »8HNFBLT 

, 8HNPTSPB 

/ 

DATA 

NC23/  6,100,0  , 20,0,0 

, 2,100,0 

, 20,0,0  , 

0,0,  C 

* 

3,C,C*  , 3,20,0 

, 20,0,0 

/ 

24  COMMON/KALEPS/ 

DIMENSION  C 24 ( 4)  * NC24(  12) 

EQUIVALENCE  ( C24 ( 1 ) , 8VAR (274 ) ) , ( NC24 ( 1 ) , ND 1M ( 1 , 274 ) ) 

DATA  024/  8HWTIME  ,8HIWIND  ,8HMWSEG  / 

DATA  N 024/  30,0,0  , 3C,G,0  , 5,22,0  / 

N00M  = 30 

IF  ( AVAR. EQ. BLANK)  GO  TO  99 

SEARCH  FOR  VARIABLE  NO.  IV. 

NOOM  = C 
DO  10  IV=1,NVAR 
IF  ( AVAR.EQ.BVAR( IV) ) GO  TO  12 
10  CONTINUE 
GO  TO  99 

SEARCH  FOR  COMMON  NO.  1C. 

12  DO  20  10=1 , KQM 

IF  ( IV.GE.KOUNI ( IC).AND. IV .LT. KQUNT ( 2C+1 ) ) GO  TO  22 
20  CONTINUE 
GO  TO  *9 

COMPUTE  ITEM  NO.  FOR  VARIABLE  IV  IN  COMMON  IC. 

22  K1  = KUUNT ( IC ) 

K2  = IV-1 
ITEM  = 1 

IF  (Kl.EQ.IV)  GO  TO  25 
DO  24  K=K1,K2 
NI  - 1 
DO  23  1=1,3 

IF  (NDIM( I ,K) .NE .0)  Nl =N 1*NDIM ( I , K ) 

23  CONTINUE 

24  ITEM  = IT  EM  ♦N  I 
2 5 DO  26  1=1,3 

IF  ( INDEX! I ) • EG. 0 .AND.  NDIM ( I , I V ) .NE. 0 ) GO  TO  99 
IF  (ND1M(1,1V).EQ.0  .AND.  INDEX ( I ) .GT. 1 ) GO  TO  99 
NJ ( I ) = MAXO( INDEX! I )~1 ,C) 

NK ( I ) = MAXO! NDIM ( I , IV) , 1) 

IF  (NJ(I).GE.NK(I) ) GO  TO  99 
26  CONTINUE 

ITEM  = 1TEM+NJ(1)+NJ(2)*NK(1 )+NJ ( 3 )*NK ( 2 ) *NK (1) 

NCOM  = IC 


SEAR2510 
SEAR2620 
SEA  R2530 
SEAR254C 
SEAR2650 
SEAR2560 
SEAR2570 
SEAR258C 
S EAR259G 
SEAR2600 
SEAR2610 
SEAR2620 
SEAR2630 
SEAR264U 
SEAR2650 
SEAR266C 
SEAR2670 
SEAR2680 
SEAR2690 
SEAR2  700 
SEAR271G 
SEAR2720 
S EAR273C 
SEAR274C 
SEAR2750 
SEAR2760 
SEAR2770 
SEAR2780 
SEAR2790 
SEAR28O0 
SEAR2810 
SEAR282C 
SEAR283C 
SEAR2840 
SEAR285G 
SLAR2860 
SEAR2870 
SEAR2880 
S EAR2890 
SEAR2900 
SEAR2910 
SEAR2920 
S EAR2930 
SEAR2940 
SEAR2950 
SEAR296C 
SEAR297C 
SEAR2980 
SEAR2990 
S EAR3OC0 
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99  RETURN 
END 


SEAR3010 

SEAR3C2U 
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SUBROUTINE  UPOATE(I) 


UPDA0010 
REV  12  12/19/74U  PD  AO 020 
U PDA0030 

INTEGRATION  STEP  TO  COMPLETE  UPDA0G4G 
FOR  OUTPUT  (SUBROUTINE  AIR6G3 ) UPD A0050 

U PDAGC6G 

AT  THE  START  OF  A NEW  STEP  TO  SETUP  ANY  NEW  CONDITIONS  UPDA0070 
TO  BE  VALID  FOR  ENTIRE  INTEGRATION  STEP  UPDAG080 

A.  UPDATE  FORCE  OEFLECTION  FUNCT I ONS ( SUBROUTIN E UPDFDC ) UP0A0G90 


CALLED  BY  SUBROUTINE  OINT 

(1=2)  AT  THE  END  OF  A SUCCESSFUL 
CALCULATIONS  FOR  THAT  STEP 


(1  = 1) 


B.  TEST  FOR  LOCKED  JOINTS 


IMPLICIT  REAL  *8 ( A-H* 0-Z ) 

COMMON/CONTRL/NSEG » N JNT  * NS3* NJ3* NPL*NB LT  *NB AG, NVEH ,NGRND, NPRT (40 ) 
COMMON/JB ARTZ/  MNPL(  20)tMN6LT(  8),MNSEG(  22),MNBAG(  6), 

♦ MPL ( 3 f 5 f 20 ) ,MBLT(3,5,8) ,MSEG ( 3 , 5 , 22 ) t MB AG( 3 , 1 0 , 6 ) , 

♦ NTPL ( 5,20>,NTBLT(5,8) ,NTSEG(5 ,22) 

COMMON/TAB LES/MXNTI ,MXN TB, MXTB 1 ,MXTB2,NT I ( 50 ) »NTAB ( 500 ) , TAB ( 2000 ) 
COMMON/FORCES/PSF ( 7* 20) ,BSF(4, 20 ) , SSF(  l 0 , 20 ) ,B AGSF ( 3 , 20 > , 

♦ NPSF  f NBSF  * NSSF  tNBGSF ,NPANEL(6) , PR JNT  (6,21) 
COMMON/DESCRP/  PHI ( 3 , 22 ) ,W ( 22) ,SR ( 3 ,42 ) , HA ( 3 ,42 ) , HB ( 3 , 42 ) 

♦ ,HT ( 3 , 3,42  ), RPHI (3 , 22 ) ,RW ( 22 ) , SPRING( 5 , 63 ) 

♦ ,VISC(7,63),JNT( 21) , IPIN ( 2 1 ) ,N S, ISING( 22 ) 

♦ , IGLOB (21) 

COMMON/ SGMNTS/D (3,3,22) , WMEG(3 ,22) ,WMEG0(3,22) ,U1 ( 3,22 ) ,U2( 3 , 22 > 

♦ ,SEGLP(3,22) , S EGLV ( 3 ,22 ) , SEGLA (3 ,22 ) ,NS YM( 22 ) 
COMMON/CM ATRX/ VI (3,21), V2(3,2I ),V3(3,12 ) ,B12 (3 ,3,42) ♦ A22 ( 3,3,42) 

♦ ,F(3,21),TQ(3,21),WJ(21) 
C0MM0N/CSTRNT/A13(3,3,24),A23(3,3,24),B31(3,3,24) ,B32( 3,3,24) 

♦ ,HHT(3,3,12I,RK1(3,12> ,RK2 ( 3 , 12  ) , QQ ( 3 , 12 ) , TQQ ( 3 , 12 ) 

♦ , RQQ ( 3 , 12) ,HQQ( 3, 12),SQQ(  12) ,CFQQ(12) 

♦ , NQ ,KQ 1 ( 12 ) ,KQ2(12) ,KQTYPL( 12) 

COMMON/TEMPVI/  TTI (3) ,R1I(3) ,R2I(3 ), CREST, JST0P( 4, 2,21 ) 

COMMON /CEULER/  I EULER (22  ),HI R( 3,3 , 21 ) , ANG( 3 , 21 ) ,ANGD(3 ,21 ) , 

♦ FE(3,21), TQE( 3,31) , CONST ( 3,21) 

COMMON/HRNESS/  BAR(t>,100)  , XL0NG(20),  IBAR(2,100), 

♦ NHRNSS,  NBLTPH( 5 ) , NFBLT(5,20), 

01 MENSION  TQTE ST ( 3 ) , LOCK (8 ,3 ) 

DATA  L0CK/-8,  6,  5,  7, -3,-2, -4,  1, 

♦ 6,-8,  4,-3,  7, -1,-5,  2, 


N THRN  S ( 20) , 
NPT  SPB ( 20 ) 


4, -8, -2,-1,  7,-6,  3/ 


UPDAC10G 
UP0AG110 
UPD AO  120 
UP0A0130 
UP0A0140 
UPDA0150 
UPD AG  160 
UP0A017C 
UPOAul 80 
UPD AC  190 
UP0A0200 
UP0A0210 
UPDAC220 
UP0AG23C 
UP0A024G 
UPDA0250 
UP0A026L 
U P0A0270 
UPOA028C 
UPDAU29C 
U PO  AO  3 00 
UPDAG31G 
UPDA0320 
UPDAG33G 
UPDAG34G 
UPDA0350 
UPDAG360 
UPDA0370 
UPDA038G 
UPDA0390 
UPDAG400 
UPDA041G 
UPDA042G 


CALL  LLTIME(1»7) 

UPDAG430 

IF  ( I .NE.2)  GO  TO  9 

UPO AO 440 

UPDA045C 

CALL  AIRBG3  FOR  AIRBAG.  IF  ANY. 

UPDAG460 

UP0A047C 

IF  ( NBAG.NE .0 ) CALL  AIRBG3 

UP0AC48G 

IF  (I.NE.l)  GO  TO  99 

UPDAC99G 

IF  (NPL.LE.O)  GO  TO  12 

0P0A0500 
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CALL  UPDFDC  FOR  EACH  ALLOWED  PLANE-SEGMENT  CONTACT. 

NPSF  = 0 

DO  11  J = 1,NPL 

NK  = MNPL(J) 

IF  (NK.LE.O)  GO  TO  11 
DO  10  K = 1,  NK 
NPSF  = NPSF+1 
NT  = NTPL ( K ♦ J ) 

NF  = NT  AB ( NT+5 ) 

CALL  UPDFDC (NT) 

IF  ( NT .GT • 0 .OR. T AB ( N F+3 ) .EW.G.G)  GOTO  10 
CALL  I MPULS ( 1 « K t J ) 

I = -1 

10  CONTINUE 

11  CONTINUE 

12  IF  (NBLT.LE.O)  GO  TO  15 

CALL  UPDFDC  FOR  EACH  ALLOWED  BELT-SEGMENT  CONTACT. 

DO  14  J = ltNBLT 
NK  = MNBLT(J) 

IF  (NK.LE.O)  GO  TO  14 
DO  13  K = 1 f NK 
NT  = NTBLT ( K»  J ) 

NF  = Nl AB ( NT+5 ) 

NT 6 = NT+6 
CALL  UPDFDC (NT) 

AND  FOR  2ND  FUNCTION,  IF  FULL  BELT  FRICTION. 

13  IF  (NF.NE.O)  CALL  UPDFDC(NT6) 

14  CONTINUE 

CALL  UPDFDC  FOR  EACH  ALLOWED  SEGMENT-SEGMENT  CONTACT. 

15  NS SF  = 0 

DO  17  J=1 , N SEG 
NK  = MNSEG(J) 

IF  (NK.LE.O)  GO  TO  17 
DO  16  K s lfNK 
NS  SF  = NSSF+1 
NT  = NTSEG ( K, J ) 

NF  = NTAB ( NT+5 ) 

CALL  UPDFDC (NT ) 

IF  (NT.GT.0.0R.TAB(NF+3 ) .EQ.O.O)  GO  TO  16 
CALL  IMPULS ( 3 , K , J ) 

I = -1 

16  CONTINUE 


UPD AO  5 10 
UPDA0620 
UPDAU53Q 
UPDA054O 
UPDAG550 
UPDAC660 
UPDA0670 
UPDAU580 
UPDA0590 
UPDA0600 
UPDAC610 
UPDA0620 
UPDAC630 
U PD AG  640 
UPDA065C 
UPDA0660 
UPDAC670 
UPDA068U 
UPDAu69w 
UPDAC700 
UPDA0710 
UPDAG720 
U PDA0730 
UPDA0740 
UPDA0750 
UPDAC76G 
UPDA077o 
UPDA078C 
UPDAG790 
UPDA0600 
UPDAU810 
UPDAC820 
U PDAC83C 
UPDA0840 
UPDAC850 
UPDA0860 
UPDA0870 
U PD AO  880 
UPDA0890 
UPDA0900 
UPDA0910 
U PDA0920 
UPDAG930 
UPDA0940 
UPDA0950 
U PD  AO  960 
UPDAC970 
UPDAC980 
UPDA0990 
UPDAluOO 
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17  CONTINUE 

IF  (NHRNSS.LE.O)  GO  TO  71 

CALL  UPOF  DC  FOR  EACH  BELT  OF  HARNESS-BELT  SYSTEMS. 

J1  = 1 
K1  = 1 

DO  7C  1 1= 1 1 NHRNSS 
IF  (NBLTPH( II ).LE.O)  GO  TO  70 
J2  = J1  ♦ NBLTPH (II)  - 1 
DO  69  J=J1,J2 

IF  (NPTSPB(J).LE.O)  GO  TO  69 
K2  * K1  ♦ NPTSPb(J)  - 1 
NT  = NTHRNS(J) 

NF  = NTAB ( NT*  5 ) 

CALL  UPDFDC (NT ) 

K 1 = K2  + 1 

69  CONTINUE 
J1  = J2+1 

70  CUNT1NUE 

71  IF  (NJNT.LF.C ) GO  TO  39 

CHECK  FOR  IMPULSE  ON  JOINT  STOPS 
TO  BE  CALLED  IF  IN  JOINT  STOP  <JST0P(1)=1>  THIS  TIME  STEP 
BUT  NO  1 IN  IN  JOINT  STOP  (JST0P(2)=C)  AT  PREVIOUS  TIME. 

DO  2 L K=1,NJNT 


IF 

( JNT(K) 

.EQ 

.0 

) 

GO 

TO 

20 

IF 

( I A bS(  I 

PIN 

(K 

) 

) 

• NE 

.A 

. AND. 

visc( 

7,3*K- 

2).EQ.0.0)  GO  70  19 

DO 

18  J*lf 

3 

K3J 

= 3*K— 

3 +J 

IF 

( 1 ABS ( I 

PIN 

(K 

) 

) 

• NE 

.A) 

K3J  = 

3*K-2 

IF 

( I ABS ( 1 

PIN 

(K 

) 

) 

.EQ 

• A 

• AND. 

V1SC( 

7.K3J) 

•EQ.C.O)  GO  TO  16 

IF 

( JSTOP( 

Jtl 

t K 

) 

. 

NE  . 

1 .OR  • J STOP ( J t 2 

,K).Nt 

.0)  GCJ  TO  18 

CALL  IMPUL 

S(9 

t J 

t 

K 

) 

I = -1 

18  JST0P(J,2,K)  = J STOP ( J , 1 fK  ) 

19  IF  ( I GLOB ( K ) • EO. 0 ) GO  TO  20 
NT  = I GLOB ( K ) 

MT  = NTAB(NT*5) 

CALL  UPDFDC (NT ) 

IF  (TAB(MT+3).EQ.0.0)  GO  TO  20 

IF  (JST0P(4,1,K) .NE.l.OR.JSTOP (4,2tK).NE .0)  GO  TO  20 
CALL  1MPULS (4 » A?  K ) 

I = -1 

20  JSTOP ( A y2  y K ) = JSTOP ( 4t 1 »K ) 

TEST  TO  LOCK  OR  UNLOCK  JOINTS 


UPDA1010 
UPDA1020 
UPDA1C  30 
UPDAlOAo 
UPDA1060 
UPDA1060 
UPDA1C7G 
UPDA1080 
UPDA109o 
UPDA1100 
U PD Al 1 10 
UPDA112C 
UPDA1130 
U PD  Al  1 A 0 
UPDAllbu 
UPDA116C 
UPDA117C 
UPDA1180 
UPDA1190 
UPD Al 200 
U PD Al 2 1C 
UPDA1220 
UPD Al 230 
U PD Al 2 40 
UPD Al 250 
UPDA126C 
UPDA1270 
UPD Al 280 
UPD Al 290 
UPDA1300 
UPD Al 3 10 
UPDA1320 
UPDA1330 
UPDA134G 
UPDA1360 
UPD Al 360 
UPDA137  0 
UPDA138C 
UPDA139G 
UPDA1AO0 
U PD Al A 10 
U PD Al 420 
U PD Al 430 
UPDA1A4G 
UP0A146G 
UPDA146C 
UPDA1470 
UPDA1A80 
UPDA199C 
U PO Al SCO 
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CONDITIONS  TO  CHANGE  SIGN  OF  IPIN(J) 


UNLOCKED 


UPDA1S10 
U PD  A 1 5 2 0 


PINNED 

UNPINNED 

U PD Al 530 

(-1)  IH.TQI 

> 

T 1 

(“2) 

ITQI  > 

T 1 

UPDA1540 
UPD Al 550 

(♦1>  IH.TQI 

< 

T 2 

( •f2  ) 

|TQ|  < 

T 2 

UPD Al 560 

OR 

OR 

UPDA1570 

WJ 

< 

T 3 

WJ  < 

T 3 

UPDA1580 

21 


DO 

3G  J=1 * NJNT 

IF 

( I AbS( I PIN ( J 

) ) 

.EQ. 

4) 

IF 

(IPIN(J) 

) 21 

,30,22 

T1 

= VISCU 

, 3*  J 

-2 

) 

IF 

(Tl.EQ.G 

• 0) 

GO 

TO 

30 

IF 

( I P IN( J ) 

.LE. 

“2 

) TQM 

IF 

(IPIN(J) 

• EQ. 

“1 

) TQM 

IF 

(TQM-T1  ) 

30, 

30 

» 29 

T 2 

= V1SC ( 5 

, 3*  J 

“2 

) 

IF 

(T2.EQ.0 

• 0) 

GO 

TO 

23 

IF 

( I P INI J ) 

• GE. 

2) 

TQM 

IF 

( IPIN( J ) 

• EQ. 

1 

) TQM 

IF 

(TQM-T2  ) 

28, 

30 

i 30 

T3 

* V ISC ( 6 

,3*  J 

“2 

) 

IF 

(T3.EQ.0 

.0  ) 

GO 

TO 

30 

IF 

( W J ( J)-T3)  28, 

3C , 3 

0 

GO  TO  30 


DSQRT (TQ( 1»J)**2+TQ(2,J)**2+TQ(3,J ) ♦♦2 ) 


28  CALL  IMPLS2(0,J,HB(1,2*J )) 

1 = -1 

29  IPIN(J)  = “IP  IN  ( J ) 

30  CONTINUE 

TEST  TO  LOCK  OR  UNLOCK  EULER  JOINTS  AXES. 

USE  SAME  TEST  AS  ABOVE  BUT  UN  EACH  AXIS  SERARATELY. 

IF  LOCK(  IEULERfK)  IS  NEGATIVE,  AXIS  K IS  LOCKED; 

TO  UNLOCK  AXIS  SET  I HJLER  TO  “LOCK ( T EUL E R, K ) . 

IF  LOCK ( IE  ULER ,K ) IS  POSITIVE,  AXIS  K IS  UNLOCKED; 
TO  LOCK  AXIS  SET  IEULER  TO  LOCK( IEULER ,K) • 

DO  60  J=1 , NJNT 

IF  ( I A6S  ( IPIN(J)  ) .NE  .4 ) GO  TO  60 
JEULER  = IEULER(J) 

CALL  DQT(HIR( 1,1, J),TQ( I , J ) , TQTEST , 3, 1 , 3 ) 

DO  55  K=1 , 3 

K3J  = 3*  J— 3 +K 

NLOCK  = LOCK( JEULER, K) 

IF  (NLOCK. GT.C)  GO  TO  52 

IF  ( VI3C(*t,K3J).EQ.0.G)  GO  TO  55 

IF  (DAbS(TQTEST(K) ) •GT«VISC(4,K3J) ) JEULER  = -NLOCK 
GO  TO  55 


U PD  Al 590 
UPDAI600 
UPDAI6I0 
U PD  AI 620 
UPDAI630 
U PD  Al 640 
UPDA165C 
U PD Al 660 
U PD AI 670 
UPDA1680 
UPDA1690 
UPDA1700 
UPDA17I0 
UPD AI 720 
U PD A 1730 
UPDA174G 
UPDAI75C 
U PD Al 760 
U PD  Al 770 
UPD Al 780 
UPDA179C 
U PD Al 800 
UPD Al 8 lV 
UPDA1620 
U PD A183u 
U PD Al 840 
UPDA1850 
UPD Al 860 
U PDA  1870 
UPD A 1 880 
UPDA1890 
UPDA1900 
UPD  Al 9 10 
U PD Al 920 
UPDA1930 
UPDA1940 
U PD  Al 950 
U PD Al 960 
U PD  Al  97  0 
UPDA198U 
U PD  Al 990 
UPDA20C0 
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52  IF  (V1SC(5,K3J).EU.0.0)  GO  TO  53 

IF  (DABS(TQTEST(K) ) .LT.V1SC( 5,K3J) ) JEULER  = NLQCK 
GO  TO  55 

53  IF  ( V1SC(6,K3J).EQ.C.C)  GO  TD  55 

IF  (DABS(ANGD(K, J ) ) .LT. VISC(6,K3J) ) JEULER  = NLOCK 
55  CONTINUE 

IF  (JEULER.EQ.1EULER( J) ) GO  TO  60 
IF  ( JEULER. EQ. 8)  GO  TO  59 

MODE  = -1 
K = JEULER 

IF  (K.LE.3)  GO  TO  57 
MODE  = 1 

K = K-3 

IF  (K.GT.3)  MQDE=G 
57  IEULER(J)  = 8 
IP1N(J)  = 4 

CALL  1MPLS2 (MODE t J»H1R( 1,K, J)) 

1 = ~1 

59  1EULER(J)  = JEULER 
1P1N(J)  = 4 

IF  ( 1 EULER  ( J ) .NE • 8 ) 1P1N(J)  = -4 

60  CONTINUE 

39  IF  (NQ.LE.O)  GO  TO  99 
DO  40  K=1 1 NC 

IF  (KOTYPE (K) .LT. 3)  GO  TO  4C 
IF  ( KOTYPE ( K ) • GT • 4 ) GO  TO  40 
IF  (CFQC(K ) •LT.O.O)  KOTYPE (K ) =-KQTYPE(K) 

IF  ( C FGO(  K ) .LT .0  *0  ) GO  TO  42 

TEST  IF  ROLLING  CONSTRAINT  SHDULD  BE  SLIDING  AND  VICE  VERSA. 

ON  = -XDY(TOO ( 1|K ),HHT( 1 ,1,K ) , QQ< lfK) ) 

IF  (NPRK24J.NE.0)  dRITL  (6,41)  KQTYPE  ( K ) , KQ  1 ( K ) , KQ2  ( K ) , 

* ( RK1 ( 11 ,K ) , 11=1 ,3),(RK2( II, K), 11-1,3), 

* (( HH 1(11, J,K),J=1, 3), 11=1,3), 

* ( 00 ( II, K) , 11=1,3) , (TwO ( 1 1 , K ) ,11=1,3), ( RCQ(11 ,K) , 11=1,3) , 

* (HOO ( 1 1 ,K ) ,11=1,3) ,SQQ(K) ,CFQO(K) , ON 

41  FORMAT ( f0  UPDATE  ROLL-SLIDE  TES1 V ( 2X, 9G 14.6  ) ) 

IF  (ON.LT.C.O)  KOT YP  E ( K ) = -4 

IF  (ON.LT.C.O)  GU  TO  42 

QDOTG  = 00(1,K)**2  ♦ 0Q(2,K)**2  ♦ 0Q(3,K)**2 
OT  = DSORT ( QDGTQ-QN**2 ) 

IF  (KCTYPE(K) .EQ.3  .AND.  OT . LE .CFOO ( K ) ♦ON ) GO  TO  40 
IF  (KOTYPE (K) .E0.4  .AND.  OT .GE .0 .9*CFQQ ( K ) ♦ON ) GD  TD  40 
KQTYPL(K)  = 7— KOTYPE ( K) 

42  CALL  DUTPUT(C) 

CALL  SETUP2 
CALL  LAUX(K) 

CALL  DUTPUT ( 1 ) 


UPDA201C 
UPDA2020 
UPDA2030 
UPDA2040 
UPDA2C5o 
UPDA2060 
UPDA2C7C 
UPDA^080 
UPDA209w 
UPDA21CG 
UPDA2110 
UP0A212C 
UPDA2130 
UPDA2140 
UPDA2150 
UPDA2160 
UPDA217C 
UPDA218U 
UPDA2190 
U PDA2^00 
UPDA2210 
UPDA 2220 
UPDA2230 
UPDA2240 
UPDA2230 
UPDA2260 
UPDA227G 
UPDA2280 
UPDA229w 
UPDA23CG 
UPDA231C 
UPDA232  0 
UPDA2330 
UPDA234L 
UPDA235C 
UPDA2360 
UPDA2370 
UPDA2380 
UPDA2390 
UPDA240G 
UPDA2410 
UPDA2420 
UPDA2430 
UPDA2440 
UPDA2450 
UPDA246C 
UPDA2470 
UPDA248u 
UPDA^49G 
UPDAc5G0 
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CALL  PRINT ( 6HUPDA7E ) 
I = -1 
4C  CONTINUE 
99  CALL  ELTIME ( 2 » 7) 
RETURN 
END 


UPUA251G 

UPDA252C 

UPDA2530 

UPDA25A0 

UPDA255G 

UPDA2560 
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SUBROUTINE  VEHPOS 


REV  12 

COMPUTE  COMPONENTS  OF  VEHICLE  POSITION  ANO  MOTION  AS  A FUNCTION 
OF  TIME  USING  DATA  ANO  TABLES  PRODUCED  BY  SUBRUUTINE  VINPUT. 


IMPLICIT  REAL*8  (A-H,0-Z) 

COMMON /CONTRL/NSEG.NJNT  ,NS3,NJ3,NPL,NBLT,NBAG,NVEH,NGRND,NPRT(40) 
C0MM0N/SGMNTS/0( 3,3 .22) ,HMEG(3,22 ) , WMEGO ( 3 , 2 2 ) ,U1 ( 3 ,22 ) ,U2( 3,22) 

* ,SEGLP(3,22) ,SEGLV( 3,22) ,SEGLA(3,22 ) ,NSYM<22) 

COMMON /VPOSTN / T1ME,X0( 3) , XDOT 0(3) ,XCOMP (3) , XVCCMP(3) , AX( 3 ) , 

* ANGLE (3), VMPH, VTIME, ATAB ( 15,100) , ATO , ADT ,CME GA , 

* NATAB,NACLR,DVEH(3,3),VMrG(3),VM  EGO ( 3 ) , X ACOMP ( 3 ) , 

* THET ( 3 ) ,ZP  LT ( 3 ) 

CO MM ON /CNS NTS/  PI,  R AOI AN, G, TH IRO, EPS1 , E PSA , EPS6 , EPS8 , 


V EH POO  10 
12/16/7AVEHPG02C 

V EHPC'030 

V EHPC040 

V EHPG05G 
VEMP0060 
VEHP0070 

V EHPCCBu 
VEHP0090 
V EH  Pol 00 
VEHPG110 
VEHP0120 

V EHPU 130 
VEHP01AC 


EPS12,EPS15,EPS2C,EPS24, UNITL,UN1TM,UNITT,GRAVTY( 3)VEHPG15o 


DIMENSION  AC ( 3 ) 

DATA  TLAST/— 100000.0/ 

T = TIME 

IF(NA1 Ab.NE.O)  GO  TO  20 

HALF-SINE  WAVE  DECELERATION 

IF(T.GT  .VTIME)  T = VTIME 
WT  = OMEGA*T 
CWT 1 = 0C0S(WT)-1.C 
SWT  = OSIN ( WT ) 

DO  1C  1=1,3 
AW  = AX ( I ) *0M  EGA 
XACOMP ( I ) = -AW*OMEGA*SWT 

XCCMP(I)  = AX ( I ) *SWT  * 1*{XDOTC(I)-AW)*XO(I) 
XVCOMP(I)  = AW*CWT 1 * XOUTO(I) 

GO  TO  99 

20  IF  (NATAB.LT.O)  GO  TO  30 

UNIDIRECTIONAL  DECELERATION 
IF  (T.LT. VTIME)  GO  TO  21 

TIME  POINT  EXCEEDS  TABLE,  EXTRAPOLATE. 


10 


DLT  = T-VTIME 

ACO  = ATAB( l.NATAB ) 

AC ( 1 ) = ATAB ( 2 ,NATAB ) * 
AC ( 2 ) = AT  AB( 3 ,N ATAB ) * 
GO  TO  25 


G*ACC*OLT 
AC  ( 1 ) *DL  T 


+ 0.5*G*ACC*DLT**2 


USE  QUAORATIC  INTERPOLATION  FROM  TABLES  FOR  CURRENT  VALUE  OF 
TIME  TO  BE  CONSISTENT  WITH  SIMPSON  INTEGRATION  OF  TABLES. 

21  J=  0. 5* (T-ATO  J/ADT  *1.0 


VEHPG160 
VEHP0170 
VEH  PO  180 
VEHPC19C 
VEH  Pt<200 
VEH PC  2 10 
VEHPC220 
VEHP0230 
VEHP024G 
VEHPC250 
VEHP0260 
VEHP027C 
VEHP0280 
VEHPC290 
VEHP0300 
VEHPU31G 
VEHP0320 
VEHP0330 
VEHPG340 
VEHPC35C 
VEHPC36G 

V EHP0370 

V EHP038C 

V EHPO  39u 

V EHP0400 
VEHPG410 
VEHPG420 
VEHPO430 
VEHP0440 
VEHPC450 

V EHPG460 
VEHP0470 
VEHP0480 

V EHP049C 
VEHPG500 
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XK  = T/ADT  -DFL0AT(2*J-1 ) 

XI  = XK+l.C 
X2  = XK**2-XK+I.O 
X3  = XK— 1 • 0 
UNITS  = -G 
DO  23  I =1 1 2 

T1  = (A1AB(I,2*J-1)-2.0*ATAB(I ,2*J)+ATAB (I,2*J+1)  )/6.0 
T2  = ( ATAB(I,2*J+1)-ATAB(I,2*J-1) )/4.0 
T3  = ATAB  ( I » 2*  J ) 

AC ( I ) = AT  AB(  1+1,2*  J— 1 ) +ADT*X1 * ( X2*T 1+X3*T2  +T3 )*UNI TS 
23  UNITS  = 1.0 

ACC  = Q.5*XK*X3*ATAb(l,2*J-l ) 

* - X3*X1*ATAB ( 1 , 2 *J  ) 

* + U.5*XK*X1*ATAB( 1,2*J+1 ) 

COMPONENTS  OF  VEHICLE  ACCELERATION,  VELOCITY  AND  POSITION. 

25  DO  29  1-1,3 

XACOMP(I)  = -G*AX(I)*ACG 

xv  comp  ( i ) = Axm*Acm 

29  XCOMP(I)  = X0( I)*AX(I)*AC(2) 

GO  TO  99 


OMNIDIRECTIONAL  DECELERATION 


30  IF  (TIME.EQ.TLAST)  GO  TO  99 
DLTA  = TIME-TLAST 

IF  (TLAST. EU. -IOOOOO.O)  DLTA  = 0.0 
TL AST  = TIME 

J = (TIME-ATOJ/ADT+l.G 

IF  ( J .GE.-NATAB)  GO  TO  32 


INTERPOLATION  FROM  VINPUT  TABLES  OF  COMPONENTS  OF  VEHICLE 
LINEAR  AND  ANGULAR  ACCELERATION,  VELOCITY  AND  DISPLACEMENT. 


31 


TJ  = ATO  ♦ DFLOAT ( J-l ) *ADT 

DLT  = TIME-TJ 

DO  31  1=1,3 

AL2  = ( A T A B ( I ,J+1)  — ATAB(I , J ) ) *DLT/ADT*G 

AL1  = G*  ATAB ( I ,J ) 

XACOM P ( I ) = -AL1-AL2 

AL2  = 0. 5*AL2 

XVCOMP ( I ) = ATAB( I+3,J)-DLT*(AL1+AL2) 

XCOMP(I)  = AT  A B( I+6,J)+DLT*(ATAB( I+3,J)-DLT* (Q.5*AL1+AL2/3.C) ) 

AA  2 = ( AT AB ( I +9 , J+ 1 )-AT AB ( I ♦9 , J ) )*RADIAN/ADT 

TH  ET ( I ) = DLT  A* ( VMEG ( I ) +DLTA* (0 . 5*VMEGD ( I ) + DLT A* AA2/6.0 ) ) 

AA 2 = AA 2 * DLT 

AA  1 = ATAB( I+9,J)*RADIAN 

VMEGD(I)  = AA 1 + AA2 

VMEG(I)  = ATAB(I+12,J)*RADIAN  + D LT* ( A A 1 + 0 . 5* AA2 ) 


VEH  PG  510 

V EHPG520 

V EHP0530 
VEHP0540 
VEHP6550 

V EHP0560 

V EHP0570 
VEHP05B0 
VEHPG59G 
VEHP0600 
VEHP0610 
VEHPC62G 
VEHPG63G 
VEHPC640 
VEHP0650 
VEHPC660 
VEHPG67G 

V EHPC68C 
VEHPG69G 
VEHPG70G 
VEHPG71G 
VEHPG720 
VEH PG 730 
VEHPC74G 

V EHPG750 
VEHPG760 

V EHP077G 

V EHPG780 

V EHPG79G 

V EH  P^bOO 
VEHPGB10 
VEHP082G 
VEHP0B30 
VEHPC840 
VEHPC65U 
VEHP0860 

V EHP087G 
VEHPG6BG 

V EHPG89G 
VEHPC900 

V EHPG91C 
VEHP*/92G 

V EHPG930 
VEHPC940 

V EHPG950 
VEHPG96G 
VEHPC970 
VEH  PC  980 
VEHP099C 
VEHP1GCG 
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GO  TO  34 

TIMt  POINT  EXCEEDS  TABLE,  EXTRAPOLATE. 

32  J = - NATAB 

TJ  = ATO  + DFL0AT(J-1)*ADT 
DLT  = TIME-TJ 
DO  33  1=1,3 

XACOMP(l)  = A TAB ( I , J ) *G 

XVCOMP(I)  = ATAB(I+3,J)  +G+ATAB ( I , J ) *DLT 
XCOMP  (I)  = AT AB ( 1+6, J)  +ATAB ( 1 + 3 , J ) *DLT  ♦ 
VMEGD(I)  = 0.0 

VM  EG  (I)  = ATAB(I+12,J)* RADIAN 

33  THET  (I)  = DLT A*VMEG ( I ) 

UPDATE  DIRECTION  COSINE  MATRIX  OF  VEHICLE. 

34  CALL  DSETD(DVEH,THET,THT  ) 


0.5*G*ATA6U,J  )*DLT**2 


STORE  VEHICLE  DATA  INTO  NV EH  SEGMENT  DATA, 


99 


41 


42 


DO  42  1=1,3 
DO  41  J=1 , 3 
D( I , J , NVEH ) = 
SEGLP ( I ,NVEH) 
SEGLV ( I ,NVEH) 
SEGlA(1,NVEH» 
WMEG  ( 1 ,NVEH) 
WMEGD ( I , NVEH) 
RETURN 
END 


DVEH( I , J) 

= XCOMP(l) 
= XVCOMP ( I ) 
= XACOMPI 1 ) 
= VMEG  (I) 
= VMEGD(I) 


VEHP1010 
VEHP1G20 
VEHP1L3C 
VEHP104G 
VEHPlGf.0 
VEHP1C.6C 
VEHP1C70 
VEHP1080 
VEHP1090 
VEHP1100 
VEHP1 110 
VEHP112C 
VEHP1 130 
VEHP114C 
VEHP115C 
VEHP1  160 
VEHP1 170 
VEhPl 180 
VEHP119G 
VEHP1200 
VEHP1210 
VEHP1220 
VEHP1230 
VEHP124G 
VEHP1260 
VEHP1260 
VEHP1270 
VEHP1280 
VEHP129C 
VEHP1300 
VEHP1310 
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SUBROUTINE  VINPUT 

PERFORMS  CARO  INPUT  AND  COMPUTES  DATA  AND  TABLES 
SUBROUTINE  VEHPOS  TO  INTEGRATE  THE  CRASH  VEHICLE 
THREE  PERMISSABLE  OPTIONS: 

(1)  HALF  SINE-WAVE  LINEAR  DECELERATION 

(2)  UNIDIRECTIONAL  LINEAR  DECELERATION 

(3)  OMNIDIRECTIONAL  LINEAR  AND  ANGULAR 
INPUT  (6  DEGREES  OF  FREEDOM  VEHICLE 


REV  12 
REQUIRED  BY 
MOTION  FOR  ONE 


IMPULSE 
TABULAR  INPUT 
ACCELERATION 
MOTION) 


TABULAR 


IMPLICIT  REAL*8  (A-H,0-Z) 

CQMMON/CQNTRL/NSEG  * N JN  , N$3,NJ3,NPL,NBLT , NBAG,NVEH ,NGR NDf NPRT (40 ) 
COMMON/SGMNTS/D( 3,3,22) , WMEG ( 3 , 22 ) , WMEGD ( 3 , 22 ) ,U 1 ( 3, 2 2 ) ,U2(3, 22 ) 

* ,SEGLP(3,22) ,SEGLV(3,22), SEGLA(3,22 ) ,NSYM(22) 
COMMON/DESCRP/  PH I ( 3 , 22 ) , W ( 2 2 ) , SR ( 3 ,42 ) , HA ( 3 , 42 ) , HB ( 3 , 42 ) 

* ,HT ( 3 , 3 ,^2 ),RPHI ( 3 ♦ 22 ) , RW( 22 ) , SPR ING ( 5 , 6 3 ) 

* ,VISC(7,63),JNT(21),IPIN(21),NS,ISING(22) 
CQMMON/VPOSTN/  TIME,XC(3), XDOT 0(3) ,XCGMP ( 3 ) , XVCOMP (3 ) , AX(3)t 

* ANGLE (3) ,VMPH, VTIME, AT AD ( 15  9 ICO) , ATO , ADT , OMEGA , 

* NA  T Ab  , N AC  LR,  DV  EH  ( 3 , 3 ) , VM E G ( 3 ) , VM  EGD  ( 3 ) f X ACCM  P ( 3 ) , 

* THET ( 3 ) , ZPLT (3 ) 

CO  MMQN/CNSNT  S/  PI,  R ADI  AN, G, TH IRD , EPS1 , E PS4 , EPS6 , E P$8 , 


VINPC010 
12/16/74VINPCG2C 
V INP0030 
0FVINPC04C 
V IN  PC050 
VINPC060 
V INP0070 

V IN  PC  080 

V INPC09G 

V IN  PC  ICO 
VINPQ11C 

V IN  Pc  12  0 
VINPC13C 
VINP014C 

V IN  PC 15C 

V IN  PC  160 
VINPG17G 
VINP01BU 
VINP019G 
VINPC20G 
VINPG21C 
VINPG220 


► EPS129EPS15,EPS2C, EPS24,  UN  IT L , UNITM ,UN I IT , GRAVTY ( 3 ) V INPO 230 

COMMON/TITLES/  UATE ( 3 ) , COM ENT ( 40 ) , VPSTTL ( 2C ) , BDYTTL{ 5 ) , BLTTT L ( 5 , 8 ) V IN P0240 


♦ ,PLTTL(5, 20) ,BAGTTL( 5,6) ,$EG(22) , JOINT (21) 

♦ ,CGS  ( 22  ) , JS(  2 I ) 

REAL  D ATE, COM  ENT, VPSTTL ,BDYTTL,BL TTTL, PL TTL , BAGTT L , SEG , JOINT 
LOGICAL*!  CGS , JS 
REAL  VEH, GRND 

DATA  VEH/1  VEH •/, GRND/ 1 GRND1 / 

READ  AND  PRINT  CONTENTS  OF  CARDS  C.l  AND  C.2 


READ  (5*10)  VPSTTL 
1C  FORMAT  (20A4) 

READ ( 5 ,11)  ANGLE, VMPH, VTIME, XO, NAT AB, ATC, ADT 
11  FORMAT (8F6.0, I6,2F6.0) 

WRITE  ( 6, 14)  VPSTTL, ANGLE, VMPH , VT I ME ,X0 , NAT A B, ATC , ADT 
14  F0RMAT(*1  VEHICLE  DECELERATION  INPUTS1 , 9 IX,  • CARDS  C1// 

* 3X , 20 A4//7X , 9 YAW  1 , 9X , 1 P IT V INPG4G0 

*CH • , 7 X, 'ROLL*  ,8X, • VMPH • , 8X , * VT IME • , 7X , • X 0 ( X ) » , 7X , 9 XO ( Y ) 1 , 7X , • XG ( 2 ) V IN PC  4 10 
*• ,7X,  1 NATAB 1 , 4X, 1 ATC 1 , 9X , • ADT • /8F12 .3 , I 10 , 2X , 2F12 . 6)  V IN PC 420 


VINPu  250 
VINPG260 
VINPC270 
VINPG28G 

V IN  PG29G 
V INPG3G0 

V IN  PC  310 
VINPG32G 

V IN  P033G 
V INPG340 
VINPG350 

V IN  PO  360 

V IN  PC  370 

V IN  PC  3 80 

V IN  PC  390 


VIPS  = VMPH 
DAI  = ANGLE (1 )*RADIAN 
DA2  = ANGLE (2 )*RADIAN 
AX ( 3 ) = DCQS( DA2  ) 

AX ( 1 ) = DC0S(DA1)*AX (3) 
AX ( 2 ) = DS I N ( D A1 ) *AX ( 3 ) 
AX ( 3 ) = DS IN ( DA2 ) 

IF (NATAB. NE.G)  GO  TO  20 


VINPG43C 
VINP044C 
V INP0450 

V INPC46G 

V IN  PG47G 
VINPC<t80 
VINPC490 
VINPG5C0 
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HALF-SINE  WAVE  DECELERATION 

DM  EG  A = PI/VTIME 

AT  = C • 5*V I PS/DMEGA 

IF  < VIPS.LT.O.G)  VIPS  = G.O 

DD  12  1=1,3 

XDDTO(I)  = VI  P S*  AX  ( I ) 

12  AX ( I ) = AT*AX(I) 

WRITE  (6,13)  VIPS, UN1TL,UNITT, ANGLE, VTIME,UNITT 

13  FORMA T ( *0  PASSENGER  COMPARTMENT  DISPLACEMENT  HISTDRY* / 

* » ANALYTICAL  HALF-SINE  WAV t DECELERATION*/ 

* » VG=»,F8.3,1X,  AA,  VNAA,*,  OBLIQUE  ANGLtS  =*,3F7.2, 

* * DEGREES,  TIME  DURATION  = » , F 7.  3 , IX  , AA// ) 

GD  TO  AI 

2 G IF  (NATAB.LT.  0)  GO  TO  50 

FDR  UNIDIRECTIONAL  VEHICLE  MOTION 

READ  LINEAR  DECELERATION  TABLES  FROM  CARDS  C.3 

READ  (5,21)  (ATAb( 1,1 ),  1=1 , N AT  AB ) 

21  FORMAT  (I2F6.G) 

EXTEND  TABLE  IF  NECESSARY  SUCH  THAT  NATAB  IS  ODD  AND 

LAST  ENTRY  NEED  NDT  BE  ZERO.  IF  TABLE  SIZE  IS  EXCEEDED  ON  TIME, 

VALUE  OF  LAST  ENTRY  WILL  BE  USED. 


IF  (MOD(NATAB ,2 ) «EQ. 1)  GC  TO  23 
ATAB ( 1 ,NAT AB  + 1 ) = AT AB ( I ,N AT AB ) 
NATAB  = NATAB+I 

23  VTIME  = ADT  * DF LO AT ( NA T AB-I ) 


USING  S IMP SON  * S INTEGRATION,  COMPUTE  VELOCITY  AND  DISPLACEMENT 
TABLE  FOR  NATAB  EQUALLY  SPACED  (ADT)  TIME  PDINTS. 

FOR  1=1, NATAB 

ATABUtl)  = LINEAR  DECELERATION  (G*S) 

AT  A B ( 2 , 1 ) = LINEAR  VELOCITY  (L  UNITS/T  UNITS) 

ATAB  (3,1 ) = LINEAR  DISPLACEMENT  (L  UNITS) 


AfAB(2,l)  = VIPS 

AT  AB ( 3 , 1 ) = G.O 

DAI  = ADT/3.C 

DA2  = ADT/12.0 

UNITS  = -G 

DO  3G  J=2 , 3 

DO  25  1=2, NATAB, 2 

FI  = AT  AB ( J-l , 1-1 ) * UNITS 

F2  = ATAB( J-l, I ) * UNITS 

F3  = ATAB( J-ltl+l)  * UNITS 

AT  AB  ( J , I ) = AT  A B ( J , I — 1 ) ♦ DA2*  ( 5 . C*F  1 + 8 .0  + F2-F3  ) 


V IN  PC  5 1 G 

V IN  PG  620 

V IN PU63G 

V IN  PG  5 AC 
VINP0550 
VINPG660 
VINPL57G 

V IN  PG58C 
V INPG590 
VINP060G 
VINPG61G 

V IN  PC62G 
VINPG63G 

V IN  PC  6 AG 

V IN  PC650 
V IN  PO  660 

V IN  PC  670 
VINPG68G 
VINPG69G 

V IN  PG  700 
VINP071C 
VINPG720 
V INPu73G 
VINP07AC 
V INPG75G 
V INP076C 
V INP077G 
V INP0780 
V INPC79G 

V IN  P0800 

V IN  PO  8 1C 
V INP062G 
VINPG83G 
V INPG8A0 

V IN  PC85C 
VINP0860 
V I NPC  8 70 
VINPG88G 
VINP0890 
VINP09U0 
V IN  Pc9 10 

V IN  PG920 
VINPU93G 
VINPG9AG 
VINP0950 

V INPG960 
V INP097G 

V IN Pu980 
V INPG990 
VINP10CG 
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ATAB ( J * I — 1 ) ♦ DA  1* ( 


F1*4.0*F2*F3 ) 


25  ATAB ( J » I + l ) = 

30  UNITS  = 1.0 

PRINT  TABLES 

WRITE  (6,36)  ( UN  I T L , UN I T T • UN I T L 1 1 s 1 • 2 ) 

36  FORMAT ( 'C  UNIDIRECTIONAL  VEHICLE  POSITION  TABLES*// 

* 2 ( * TIME  ACC  VELOCITY  POSITION  ’)/ 

* 2 ( * (MILLESEL)  (G)  ( • , A4, •/ • , A4, • ) • , 5X, • ( • , A4, • ) • )/ ) 

DO  hU  J=1 , 5C 

IF  (J.GT.NATAB)  GO  TO  40 
T1  = (ATO  ♦ DFLOAT( J-l) *ADT)*1000.C 
IF  ( J+5C.LE.NATA6)  GO  TO  38 
WRITE  (6,37)  Tl, ( ATAB(I , J) ,1=1 ,3) 

37  FORMAT ( 2( F 1 1 . 5 , F 10. 2 , F 13. 4, F 13.5, 3X) ) 

GO  TO  40 

38  T2  = (ATO  ♦ DFLOAT ( J+49 ) *ADT ) *1000.0 

WRITE  (6,37)  Tl,(ATAb(I,J),I=l,3),T2,(ATAB(I,J*50),I=l,3) 

40  CONTINUE 

INITIALIZATION 
DO  35  1=1,3 

35  XDOTO ( I )=  V IP  S*AX ( I ) 

41  DO  43  1=1,3 
DO  42  J=1 , 3 

42  DV EH ( 1 , J ) = 0.0 
DVEH ( I , 1 ) = 1.0 
VMEGD(I)  = 0.0 

43  VMEG ( I ) = 0.0 

GO  TO  99 

FOR  OMNIDIRECTIONAL  (6  DEGREES  OF  FREEDOM)  VEHICLE  MOTION 
READ  LINEAR  DECELERATION  AND  AUGULAR  ACCELERATION  TA6LES 
FROM  CARDS  C.4. 

50  MATAB  = -NATAB 

READ! 5,51)  ( ( ATAB( I , J ) , I =1 , 3 ) , ( ATAB( 1 , J ) , I = 1 0, 12 ) , J=1 , MATAB ) 

51  FORMAT (10X,6FIC.0) 

DO  60  J=I, MATAB 

IF  (M0D(J,50).NE.l)  GO  TO  53 

PRINT  PAGE  HEADING  AT  START  OF  EACH  50  TIME  POINTS. 

IF  (J.NE.l)  WRITE  (6,44) 

44  FORMAT ( *1* ) 

IPAGE  = (J-D/50  ♦ 1 

WRITE  (6,52)  I PAGE, UN IT L »UNITT  »UNI TL ,UNI TT 

52  FORMAT ( *0  ROTATING  VEHICLE  LINEAR  TIME  HISTORY*, 

* 67X, 'PAGE  NO. *,I3// 


V IN  P1010 
VINP1O20 
VINPIG30 

V IN  PI 040 
V1NP105C 

V IN  P1060 
VINP107C 
V INP 108u 
V INP1090 
V INPllOG 
V1NP111G 
VINP1120 
VINP1130 

V IN  PI 140 

V IN  PI 1 50 
VINP116W 
VINP1170 
VINP118C 

V IN  PI  1 90 
VINP120G 
V INP1210 
V INP122C 
V1NP1230 
VINP1240 
VINP1250 
V1NP126G 
VINP1270 
VINP1280 
VINP1290 
VINP1300 
VINP131C 
VINP1320 
VINP1330 
VINP134C 
V1NP1350 

V IN  P136C 

V INP137G 
VINP1380 

V IN  P1390 
VINP1400 
V INP1410 
VINP142C 
VINP1430 
V1NP1440 
VINP1450 

V IN PI 460 
VINP1470 
VINP1480 
VINP1490 
V INP1500 
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* 4X*  #TIME#  »12X,  ’LINEAR  DECELERATIONS  (GB#S)** 

* 1GX  * • L I NE  AR  VELOCITIES  C • , A4* V • , A4, • ) • , 

* 1 1 X i #L  I NEAR  DISPLACEMENTS  (SA^,M»  / 

$ 3X,M  *tA4f  ,),t3(lIXt*X*,llX,,Y,tlIXt  *Z#,3X)  / ) 

53  IF  ( J.GT.l  ) GO  TO  57 

INTEGRATION  INITIALIZATION  FOR  TIME  = 0. 

DO  54  1=1*3 

AT Ab  ( I +6*  J ) = X0(  I ) 

AT  AB( 1+12* J ) = 0.0 

54  THET(i)  = ANGLE (I )*RADIAN 
CALL  DRCYPR ( DV EH* ANGLE *3*2*1) 

DO  55  1=1*3 

XDOTG(I)  = VIPS*DVEH( 1* I ) 

55  AT  AB ( I +3*  J ) = XDOTO(I) 

GO  TO  59 

57  DO  58  1 = 1*  3 

INTEGRATE  LINEAR  VELOCITY  AND  DISPLACEMENT. 

AT  AB ( I +3* J ) = ATAB(I+3* J-l )-G* ADT/2«0* ( AT AB ( I • J-l ) +ATAB ( I » J) ) 

58  AT  AB ( I +6*  J ) = AT  AB ( I +6*  J— 1 ) 

* +ADT* ( ATAB(I+3t J-l ) -G*ADT/6. 0* <2.0*ATAB ( I * J-l  )+ATAB(If J) ) ) 

59  T1  = (ATO  ♦ DFLOATC J-1)*ADT) 

60  WR  IT  E ( 6 *6 1 ) T 1 * ( AT  AB  ( I * J ) * 1=  1 , 9) 

61  FORMA T ( F9. 5 *3 ( 3X * 3F1 2 .3 ) ) 

DO  70  J=1 * MAT  AB 

IF (MOD( J*50).NE.l)  GO  TO  63 

PRINT  PAGE  HEADING  AT  START  OF  EACH  50  TIME  POINTS. 

IPAGE  = ( J — 1 ) /50  + 1 

WRITE  (6*62)  IPAGE* UN  ITT  *UNITT  * UN  ITT 

62  FORMAT ( #1  ROTATING  VEHICLE  ANGULAR  TIME  HISTORY*  * 

* 66X  * *P AGE  NO. **I3// 

* 4X* •TIME**  6X**ANGULAR  ACCELERATIONS  ( DEG/ * * A4* B**2 ) f * 

* 1 OX  * * ANGUL  AR  VELOCITIES  ( D EG/ * * A4* • ) * * 

* 1 1 X * * ANGULAR  DISPLACEMENTS  (DEG)1  / 

* 3X*  * ( * *A4* • ) • *2( 11X, *X*  *11X*  *Y*, 11X*  * Z*  * 3X ) * 

* 10X* *YAW* *8X* *PI1CH**8X**RULL*  /) 

63  IF(J.EQ.l)  GO  TO  65 

INTEGRATE  ANGULAR  VELOCITY  AND  DISPLACEMENT • 

DO  64  1=1*3 

AT  AB ( I +12  * J ) = ATAB(I+12vJ-l)+(ATAB(I  + 9« J-1)+ATAB(I  + 9V J))*ADT/2.0 

64  THET(l)  = ADT  * ( ATAB ( I+l 2 * J— 1 )♦ (2 .G*ATAB ( I ♦9*  J— 1) +ATAB ( 1+9  *J ) )*ADT 
*/6.0)*RADlAN 

CALL  DSETD ( DV  EH, THET  * THT ) 


VINP151C 

V IN  PI  520 

V IN  PI  530 
VINP154C 
VINP1550 
VINP1560 

V IN  P 1570 
VINP1580 

V IN  PI  590 
V INP16C0 
VINP161U 
VINP162C 
V IN  Pi  630 
VINP164C 

V IN  Pi 650 

V IN  Pi  66 l 

V IN P 1670 
V INP1660 
VINP1690 

V IN  PI  700 
VINP1710 
VINP172C 

V IN  P 1 73t 
VINP1740 

V IN  Pi  750 

V IN  Pi  7 60 
VINP177C 
VINP176U 
V INP1790 

V IN P 1 600 
VINP1810 
V INP1 620 
V1NP1630 
VINP1840 
VINP185C 
V IN  Pi 86C 
VINP1870 
VINP1880 

V IN  PI  890 
VINP190C 
VINP191C 

V INPI920 
VINP1930 
VINP1940 

V IN P1950 
VINP196G 

V IN  PI 970 

V IN  P1980 
VINP199U 
V INP200C 
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6S> 

CALL  YPRDEG(DVEH*THET ) 

V INP2010 

T1  = (ATO  + DFLOAT ( J-l ) *ADT ) 

V INP2C2G 

70 

WRITE  (6,71)  Tl» (ATAB( 1 ,J ) » 1=10, 15) ,THET 

VINP2C30 

71 

F0RMAT(F9.5,3(3X,3F12.3>  ) 

V INP2040 
V 1NP2050 

PROGRAM  INITIALIZATION  FOR  TIME  = C. 

VINP206G 

VINP207G 

CALL  DRCYPR  ( DVEH , ANGLE , 3, 2, 1 ) 

V 1NP2080 

DO  72  1=1,3 

V INP209G 

VMEG(I)  = ATAB( 1+12 , 1 ) *RAD1 AN 

V IN  P2 100 

72 

VMEGD(I)  = ATAB(I+9  ,1)*RAD1AN 

VINP211G 

VINP2120 

SET  UP  SEGMENT  DATA  FOR  GROUND. 

VINP213G 

VINP214G 

99 

NV  EH  = NSEG+1 

VINP2  li>0 

NGRND  = NVEH+1 

VINP2160 

SEG(NVEH)  = VEH 

VINP217C 

SEG(NGRND)  = GRND 

V1NP2  180 

IF  ( NVEH  -l.GT.NJNT)  JNT  ( NVEH  -1)  = 0 

V1NP2190 

IF  (NVEH  -l.GT.NJNT)  1P1N(NVEH  -1)  = 0 

V1NP22GC 

IF  (NGRND-l.GT.NJNT)  JNT  ( NGRND-1 ) = 0 

V1NP221G 

IF  (NGRND-l.GT.NJNT)  IPIN( NGRND-1 ) = G 

V INP222G 

DO  82  1=1,3 

V1NP223C 

DO  81  J=1 , 3 

V INP2240 

81 

D( I, J , NGRND)  = C.O 

VINP22bG 

D( I, I .NGRND)  = l.G 

V 1NP226G 

SEGLP ( 1, NGRND)  = 0.0 

V1NP227C 

SEGLA ( I .NGRND ) = O.C 

V 1NP228C 

SEGL  V ( 1 , NGRND ) = 0.0 

V1NP2290 

WMEG  (I, NGRND)  = 0.0 

VINP2300 

82 

WMEGDd, NGRND)  = 0.0 

V1NP231C 

DO  83  J=NVEH, NGRND 

V INP232C 

W(J>  = C.O 

V INP233C 

RW ( J ) =0.0 

V INP234G 

DO  83  1=1,3 

V IN  P2  35v* 

PHI ( 1 , J ) = 0.0 

V1NP236G 

83 

RPHKI.J)  = 0.0 

V INP237C 

RETURN 

V1NP238G 

END 

VINP2390 
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SUBROUTINE  V1SPR(IJ,NJ) 

COMPUTES  V1SC0S  AND  SPRING  TORUUES  AT  THE  JOINTS 
AND  ADDS  THEM  TO  THE  U 2 ARRAY. 

ARGUMENTS: 

NJ  = 0 - REGULAR  COMPUTATION  FOR  ALL  JOINTS 
» 0 - COMPUTE  ONLY  FOR  JOINT  NJ  IMPULSE 


VISPC01C 
REV  12  12/19/74VISP002G 
VISPCG3G 
VISPC04O 
V ISPC060 
V IS  PC  060 
VISPC07C 
VISPuOfaO 
VISP009C 


1J  = 1 IMPULSE  FOR  FLEXURE  ONLY 
= 2 IMPULSE  FOR  TORSION  ONLY 
= A IMPULSE  FOR  GLUB ALGR APHI C ONLY 

IMPLICIT  RE AL*8  <A-H,0“2) 

COMMON/CONTRL/NSEG,NJNT, NS3, NJ3 ,NPL ,NBLT ,NB AG, NVEH ,NGRND ,NPRT < 40 ) 
COMMON/DESCRP/  PHI < 3 , 22 ) , W < 2 2 ) , SR < 3 ,42 ) , HA( 3 ,42 ) , Hb < 3 , 42 ) 

♦ ,HT <3,3,42 ),RPHI (3,22) ,R  W(  22  ) « SPRING  ( f> * 63  ) 

♦ , VI SC (7,63), JNT< 21) , IPIN< 21 ) ,NS, ISING< 22 ) 

♦ v 1GL0B ( 2l ) » JOI NT  F(  2 1 ) 

COMMON/SGMNTS/D( 3,3,22) ,WMEG<3,22 ) tWMEGD <3 1 22 ) fUl C 3f 22 ) ,U2<  3,22) 

♦ tSEGLP ( 3 ♦ 22) t SEGLV ( 3 t22 ) , StGLA < 3 * 22 ) ,NS YM ( 22 ) 
COMMON/FORCES/PSF<  7*20)  , 6SF < 4, 20 ) , SSF < 10 , 20 ) * B AGS F ( 3 * 20 ) , 

♦ NPSF,NBSF,NSSF,NBGSF,NPANEL(6) ,PRJNT<6,21) 
COMMON/CMATRX/Vl<3,21) ,V2< 3, 21 ) * V3 ( 3, 12 ) , B1 2 ( 3 , 3 , 42 ) , A22 ( 3 , 3 , 42 ) 

♦ ,F(3*21),TQ(3*21 ) , W J ( 21 ) 

COMMON/CEULER/  I EULER < 2 2 ) , HI R < 3 , 3 , 21 ) , ANG < 3 , 2 1 ) ,ANGD<3,21 ) , 

♦ FE( 3, 21 ) , TUE  ( 3, 31 ) ,CONST<3,21 ) 
C0MM0N/TABLES/MXNtItMXNTBfMXTBlfMXTB2»NTI(50) ,NTAB (50C  ) .TAB ( 2000 ) 

COMMQN/TE  MP VS/T 1(3) , T2 ( 3) , T 3 ( 3 ) t T4 ( 3 ) , T 5 ( 3 ) , T6 ( 3 ) , T7 ( 3 ) * T8 ( 3 ) 

♦ ,T9  (3)  ,HAD,HbD,WIJM,LV,CS4,CSB  ,WI  J<  3),  ANGL<  3)  ,TQC 

♦ tTHEf OfTHETOPt DHl<3*  3) , DH2 ( 3, 3 ) , HD3 ( 3,3 ) »CC(3) 
COMMON/TEMP  VI/  TT I ( 3 ) ,R 1 1 ( 3 ) ,R2I ( 3 ) t CREST f JSTOP (4 , 2,2 1 ) 
COMMON/CNSNTS/  PI,  RADIAN, G, THIRD, EPS1,EPS4, tPS6,EPS8, 

♦ EPS12 , EPS15 i LPS2C , EPS24, UN IT L , UNIT M ,UNI TT ,GRAVTY ( 3 
COMMON  /VPOSTN/  TIME 

IF  (NJNT.LE.C)  GU  TO  99 
CALL  EL  TIM  £ (1,13) 

IF  (NPRT(12).NE.O)  WRITE  (6,11)  TIME 

11  FORMAT ( 1 1 VISPR  COMPUTATIONS  FOR  TIME  =*«F12.6) 

J1  = 1 

J2  = NJNT 

IF  (NJ.EQ.C)  GO  TO  13 
J1  = NJ 
J2  = NJ 

13  DO  90  J=J1,J2 
DO  12  L=1 , 3 

12  TQ(L,J)  = 0.0 
WJ(J)  =0.0 

DO  NOT  COMPUTE  TORQUES  FOR  NULL,  LOCKED  OR  EULER  JOINTS. 


VlSPulOG 
VISPC11G 
VISPJ120 
VISPC  130 
V I S PC  140 

V IS  Pu 160 

V IS  PO 160 
V I SPC170 
VISPC1B0 
V1SP019C 

V IS  P02GG 
VISP021C 

V IS  PC220 
V IS  P0230 
VISP0240 
VISPC  25C 
VISPG260 

V IS  PG27G 
VISPO280 
VISPC29C 

V IS  Po300 
VI SPO  31 C 
VISP0320 
VISP033C 
VISP^34G 

V IS  PC  350 

V ISP v360 
V1SPC37C 
VISP0380 

V IS  PO  390 
VISPU400 
VISPC41C 

V IS  P042C 
VISP0430 
VISP0440 
VISPC45C 
VISPC46C 
V ISP047C 
VISP0460 
VIS  Pt'490 
VISP0600 
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I = I AbS  ( JNT ( J ) ) 

IF  (I.LE.O)  GO  TO  90 
IF  ( IPIN( J ) .LT .0  .OR. 


I P IN ( J ) • GT • 3 J GO  TO  90 


ZERO  T1-T9  ARRAYS,  VARIABLES  H AD,H BD,WI JM,CV ,CS A,  AND  CS8 , 

WIJ  AND  ANGL  ARRAYS  AND  VARIA8LES  TQC,THET0  AND  THETOP. 

DO  10  L=1 ,42 
10  TI(L)  = 0.0 

CALL  DOT ( D ( 1, 1,1  ) ,HT( I,I,2*J-l),DHl,3,3,3) 

CALL  DOT (D(1,1,J+1) ,HT( 1 »I »2*J  ),DH2,3,3,3) 

CALL  D0T(DHI,DH2,HD3,3,3,3) 

NOTE:  THIS  VERSION  CORRESPONDS  TO  OLDER  VERSIONS  AS  FOLLOWS: 


♦ ANGL ( 2 ) = DATAN2(HD3 (2,3 ) ,HD3( 1,3)) 

CSAP  = 0.0 

IF  (NJ.NE.O.AND. IJ.EQ.4)  GO  TO  27 

CONVERT  TO  INERTIAL  REFERENCE  SYSTEM 

T3=  D(I ) f*WMEG(I ) T6=D< J+l) f*WMEG< J + l) 


V IS  PC  5 10 

V IS  PO 5 20 
V ISPC530 

V IS  PO  5 AO 

V IS  PC  550 
VIS  PG56C 
V ISPG570 
VIS  PC  580 
VISPC590 
VISPObOO 

V IS PC 6 10 
VISP062C 
VISP0630 
VISP0640 
VISP0650 

V ISP066C 


(HT)  = ( (HC)  (H8)  (HA)  ) 

V IS  PC670 

VISP0680 

(DH1  ) = ( (A)  ( T2 ) (TI)  ) 

VISPG690 

VISPC700 

( DH2  ) = ( (B)  ( T5 ) (TA)  ) 

VISPC7IC 

VISP0720 

WHERE  A = T2  X Tl 

VISP0730 

B = T5  X T4 

V IS  PO 740 

VISP0750 

( A.B  A.T5  A.T4  ) 

VISPC76G 

( HD3 ) = ( T2.8  T2.T5  T2.T4  ) 

VIS  P0770 

( Tl.B  TI.T5  T1.T4  ) 

VISP078C 

V IS  P079C 

HAD  = HD3  ( 3 »3  ) 

V IS  P0800 

IF  (HAD.GT.  1.0)  HAD  = I. 0 

V ISP08I0 

IF  (HAD.LT.-I.O)  HAD  = -l.C 

V IS  PC82C 

ANGL ( I ) = DARCOS (HAD ) 

V ISP083C 

ANGL ( 2 ) = 0.0 

V ISP084C 

IF  (HD3(2,3).NE.0.0  .OR.  HD3 ( I , 3 ) .NE .0 . 0 ) 

VISP0850 

V IS  P0860 

V IS  P0870 
VISP0880 
VISP0890 
VISP0900 
VIS  PC 9 10 
V ISPG920 


15 


HAD  = COS  TA  = HD3(3,3) 

VIS  P0930 

WIJ  = T3-T6 

VISP094G 

WJ  = IWIJl 

V ISP0950 

VISP0960 

DO  20  L=  1 * 3 

V IS  P0970 

DO  15  M=1 * 3 

VISP0980 

T3(L)  = T3 ( L ) ♦ D(M,L*I ) * WMEG ( M» I ) 

VISP099C 

T6(L)  = T6 ( L ) ♦ D(M* L* J + l) * WMEG(M,J  + I) 

VISP1000 
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W I J ( L ) = T3(L)-T6(L) 

20  WIJM  = WIJM  ♦ WIJ(L)**2 
WIJM  = DSQRT ( WIJM ) 

WJ(J)  = WIJM 

T7  = TI  X T4 
HAC  = | T7 | 

CALL  CROSS  (DHK  1,3)  , DH  2 (1 , 3 ) , T7 ) 

HAC  = DSQRT( ( 1 .0-HAD)*( I.G+HAD)) 

COMPUTE  CV,  THE  MAGNITUDE  OF  VISCOUS  AND  COULOMB  TORQUE/WIJM 
RA  = -SGN  TA  DOT  = WIJ.T7 
AND  CS A f THE  MAGNITUDE  OF  FLEXURE  TORQUE/HAC 

CV  = VISCOS(WlJM,VISC(l,3*J-2) ) 

CREST  = VI SC( 7 ,3* J-2 ) 

RA  = WIJ(I 1*T7(1)+WIJ(2 )*T7(2)+WIJ(3)*T7(3) 

JS  TP  = 0 

IF  ( JOINTF( J) .EQ.O)  CSA  = EFUNCT ( ANGL ( 1 ) , RA , SPR ING ( 1 , 3 *J-2 ) , J STP  ) 
IF  ( JOINTF ( J) .NE .0 ) CSA  = FNTERP ( ANGL( 1 ) , ANGL ( 2 ) , JOINTF( J ) ) 

CS AP  = CSA 

IF  (HAC. NE. 0.0)  CSA  = CSA/HAC 

IF  (NJ.EQ.O)  J STOP ( I f I v J ) = JSTP 
IF  (IPIN(J) . EQ . I ) GO  TO  34 

FOR  UNPINNED  FREE  JOINTS 

CONVERT  TO  INERTIAL  REFERENCE  SYSTEM 

T2  = D ( I ) • *HB ( N J ) T 5 = D( J + i ) f*HB ( MJ ) 

T8  - T2  X T 5 

HBD  = COS  TB  = T2.T5 

HBC  = | T8 | 

AN G L ( 3 ) * D ATAN2CHD3 ( 2 1 1 )-HD3( 1,2) fHD3(  2 *2 )+HD3( i « I) ) 

RB  = -SGN  TB  DOT  * WIJ.T8 

COMPUTE  CSB  * THE  MAGNITUDE  OF  TORSIONAL  TORQUE. 

RB  = WIJ( 1 )*DH2( 1,3)  ♦ WIJ(2)*DH2(2,3)  ♦ W I J ( 3 )*DH2 ( 3 ,3 ) 

CSB  = EFUNCT( ANGL ( 3 ), RB , SPRING ( I ,3* J-l ) , JSTP ) 

IF  (NJ.EQ.O)  JSTOP ( 2, 1 , J ) = JSTP 
IF  (NJ.GT.O)  GO  TO  34 

COMPUTE  EFFECT  OF  GLOBA LGR APH I C JOINT  STOP 

27  IF  (IGLOB( JJ.EQ.C)  GO  TO  34 

IF  (DABS(HAD) .GT.I.C-EPS6)  GO  TO  34 
NT  = I GLOB ( J ) 

CALL  HERRON (HD3( 1,3) ,NTAb( NT +1 ) ,THETO,TH ETOP ) 


V1SP101G 

VISPIC20 

V IS  P1030 
VISPI040 

V IS PI 050 
VISP106G 

V IS PIC 70 
V IS  P 1 C BO 

V IS P 1 090 
VISP1100 
VISP111C 
VISP1120 
VISP1130 
VIS  PI 140 
VISP115C 

V IS  PI 1 60 
VISP1170 
vispneo 

V IS  PI 190 

V IS  PI  200 

V IS P 1 2 10 
V ISP1220 

V IS P 1 230 
V ISP124C 
VISP1250 
V1SP1260 
V IS  PI  270 
VISP1280 
VISP129C 

V ISP  1 300 
VISP1310 
VISP132C 

V IS  P133C 
VISP134C 

V IS  PI  350 

V IS  PI  360 
V ISP137C 
V1SP1380 
VISP1390 
V ISP1400 
VISP1410 
V1SP1420 
V1SP1430 
VISP1440 
VIS  Pi 450 

V IS  P 1460 
VISP1470 

V IS  P148C 

V IS  P 1 49  C 
V1SP150C 
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28 


JS  TOP  ( 4 , 1 , J ) = 0 
IF  (ANGL( 1 ) .LE.THETG)  GO  TO  34 
JS TOP ( 4 f 1 f J ) = 1 
MT  = NTAB ( NT+5  ) 

CREST  = TAB (MT+3 ) 

STH2  - 1.0-HAD**2 
STH  = DSQRT ( STH2 ) 

CTH  = HAD/STH 

CST  = DSQRT( STH2+THET0P**2) 

DR  = ( ANGL ( 1 ) -TH  ET  0) +STH/CST 
LT  = NTAB ( NT ) 

TAB ( L T ) = DR 

TQF  = F RCD FL ( DR  » NT , 1 ) 

TQC  = TQF/CST 

CC(1)  = — H D 3 ( 2 » 3 ) ♦ HD3( 1, 3 ) *C TH+T HETGP 
CC ( 2 ) ^ HD3(1,3)  ♦ HD3(2,3)*CTH*THET0P 

CC ( 3 ) = -STH*THETQP 

DO  28  L = 1 , 3 
T9 (L)  = CC ( 1 ) ♦DH1 ( L » 1 ) 


♦ CC ( 2 ) ♦DHl ( L ,2  ) ♦ CC ( 3 ) *DH  1 ( L 1 3 ) 


COMPUTE  TOTAL  TORQUE  IN  INERTIAL  REFERENCE  BY 


* 

* 

* 


J,CVtCSA,CSB,TQC,HAD,HAC»HBC,RA,R8, 
HD3 » W I J ,T7 , T9, 

(TQ(LtJ),L=l,3) 


39  F0RMAT(I4,1P9D14.6/(4X,9D14.6) ) 

ADD  TORQUE  CONVERTED  TO  LOCAL  REFERENCE 
U21  - U2I  ♦ DI+TQ 
U2J  = U2J  - DJ*TQ 


BY 


DO  40  L=1 ,3 
DO  40  M=1 ,3 
U2 (Lt I ) * U2  (Ltl  ) 
40  U2 ( L , J ♦ 1 ) = U2(L,J+1) 


♦ D(  L , M , I ) *TQ ( M , J ) 
- D(L»MfJ^l)+lQ(MfJ) 


STORE  DATA  FOR  OUTPUT  ROUTINE  INTO  PRJNT  ARRAY « 


PR JNT ( 1 » J ) = 
PRJNT ( 2 » J ) = 


ANGL ( 1 ) 
ANGLO) 


V IS  PI  5 10 
VISP152C 
VISP1530 

V IS  PI  540 
VISP155G 
VISP156C 
VISP157C 
VISP158G 
VISP1590 

V IS  P160G 

V IS PI  610 
VISP162G 

V IS  PI 630 
VISP164C 
VISP165C 
VIS  PI  660 
VISP167C 

V IS  Pi  680 
VIS  PI 690 
VISP1700 
VISP1710 


TQ 

= -CV*WI  J 

♦ CSA  + T7  ♦ CS B*T8  ♦ TQC+T9 

V IS  Pi  720 
VIS  Pi  730 

34 

IF 

(NJ.EQ.O) 

GO  TO  36 

VISP174C 

CV 

= 0.0 

V ISP175C 

IF 

(IJ.NE.l) 

CS A = 0.0 

V IS  PI  7 60 

IF 

( IJ.NE.2 ) 

CSb  = 0.0 

VISP177C 

IF 

( I J.NE.4) 

TQC  = C.O 

VISP1780 

36 

DO 

37  L = l » 3 

VISP1790 

TQ 

(L,J)  = — CV*WI J ( L ) ♦ CSA*T7(L)  ♦ CSB*DH2(L,3)  «■  TQC*T9(L) 

V IS  PI  800 

37 

TT 

I ( L ) = TQ (L 

,J) 

V IS  P 18 10 

IF 

( NPRT  ( 1 2 ) • 

NE.O)  WRITE  (6,39) 

VISP1820 

VISP1830 

V IS  PI  840 
VIS  PI  850 
VISPI860 
VISP187G 
VISP188C 

V IS  PI  890 
VISP1900 

V IS  PI  9 10 
VISP1920 
VISP1930 

V IS P 1 940 
VISP195C 
V I S P 1 960 
VIS  PI  970 

V IS  P198C 
VISP1990 

V IS  P2000 


1S8 


PRJN1 ( 3 « J ) = CSAP 

V IS P2 CIO 

PR  JNT  ( 4 » J ) = CSB 

V IS  P2C20 

PRJNT ( 5,J)  = CV+WIJM 

V ISP203C 

PR JNT ( 6»  J ) = DSQRT(TQ(1, J) **2  + TQ ( 2 , J )**2 *10 < 3, J )**2 ) 

VISP2040 

9C 

CONT 1NUE 

V I SP2050 

CALL  CLTIMfc (2« 13 ) 

VISP2C6C 

99 

RETURN 

V ISP2070 

END 

VISP2080 
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SUBROUTINE  W1 NDY (M ,MM ,N , W ,NT ) 


REV  12 


W INDv.0 10 
12/2G/74W INDCG2C 


COMPUTES  FORCES  AND  TORQUES  ADDING  THEM  TO  THE  U1  AND  U2  ARRAYS 
OF  WIND  BLAST  FORCES  DETERMINED  BY  FUNCTION  STORED  IN  TAB ( NT ) 

ON  ELLIPSOID  (MM)  ATTACHED  TO  BODY  SEGMENT  (M)  WHICH  EXTENDS 
THROUGH  THE  INTERSECTING  PLANE  (NN)  ATTACHED  TO  SEGMENT  (N). 

IMPLICIT  R EAL*B  (A-H,0-Z) 

COMMON/CONTRL/NSEG»  NJNT  , NS3*NJ3*NPL*NSLT*NbAG»NVEH»NGRND»NPRT (40  ) 
COMM ON /TABLE S/MX NT I * MXNTB,  MXTBI»MXTB2»NTI (50) ,NTAB(5G0 ) , TAB (2000) 
COMMON/SGMNTS/D( 3,3,22) ,WMEG(3,22) ,WMEGD ( 3 ,2 2 ) ,U1 ( 3 , 22 ) ,U2 ( 3 , 22 ) 

* , S EGL  P ( 3, 2 2) ,SEGLV(3,22),SEGLA(3,22),NSYM(22) 

COMMON/ CNTSRF/  PL (17,20) ,GAB ( B ,3 ) , BELT( 20 ,8 ) ,TPTS(6,8) ,BD(24,25) 
COMMON/CNSNTS/  PI,  R ADI  AN, G, TH IRD , EPSI , E PS4 , EPS6, E PSB , 


COMMON/VPOSTN/  T IMF , XO ( 3 ) , XDOT 0( 3 ) ,XC0MP(3) ,XVCOMP (3) , AX (3 ) , 

* ANGLE ( 3 ) , VMPH, VT IME, ATAB ( 15,100) , ATO ,ADT , OMEGA , 

* NAT  AB ,NACLR, DVEH ( 3 ,3 ) , VMEG ( 3 ) , VMEGD ( 3) , XACOMP ( 3 ) , 

* THET ( 3 ) , Z PLT ( 3 ) 

COMMON/TEM PVS/  DMNT (3,3 ) ,XMN ( 3 ) , XMM ( 3 ) , T M (3 ) ,BET , BT S , P , FT ( 3 ) , 

* FF ( 3 ) ,AF (3) ,FAF ,TF , bREF , SCALE .TRACER ,AR EA , RLM ( 3 ) , 

* TQM ( 3 ) , RM  (3  ) 

COMMON/KALE  PS /WT IME ( 30) , IWIND( 30) 

CALL  ELTIME(1,35) 

COMPUTE  PENETRATION  DISTANCE;  IF  NEGATIVE,  RETURN. 


1C 


11 


CALL  D0TT(D(1,1,M),D(1, 1 ,N ) , DMNT , 3 , 3 , 3 ) 

DO  10  1=1,3 

XMN(I)  = S EGLP ( I ,M ) - SEGLP(I.N) 

CALL  MAT ( D ( 1 , 1 ,M ) ,XMN,X MM, 3 , 3, 1, 3,3,3) 

CALL  MAT (DMNT ,PL (1,NN) ,TM,3,3, 1,3, 3, 3) 

BET  = PL ( 4 ,NN ) 

DO  11  1=1,3 

BET  = BET  - TM(I )*(BD(I*3,MM)+XMM( 1) ) 

CALL  MAT(BD( 16, MM) ,TM,RM,3,3,1 ,3,3 ,3) 

BT  S = TM( I ) *RM ( 1 ) ♦ TM  ( 2 )*  RM  ( 2 ) ♦ TM(3)*RM(3) 
BT  E = -DSCRT(BTS) 

P = EET  - BTE 
IF  (P.LT.C.C)  GO  TO  49 

FETCH  OR  STORE  INITIAL  PENETRATION  TIME. 


IWIND(M)  = M 

IF  (TIME.LE.WTIME(M) ) WTIME(M) 
FTIME  = TIME  - WTIME(M) 


= TIME 


GET  FORCE  VECTOR  FT  FROM  TABLE  NT  FOR  TIME  = FTIME, 
22  XT  = NT  I ( NT ) 


W1ND0160 
WINDG170 
WIND01B0 
WIND0190 
WINDC20C 
WIND0210 
WIND0220 
W INDC23C 
WIND024C 
W1NDG25C 
W IND0260 
WIND0270 
WINDC2BC 
W IND0290 
WIND03C0 
WINDC31C 
WIND032C 
WINDG330 
WIND034C 
W INDC'3  50 
WINDC36C 
WINDC370 
W1NDC3B0 
WIN DO 3 90 
W IND0400 
W1NDG410 
W IND042C 
W IN  DC 430 
WINDO440 
WIND045C 
W IND046C 
WIND047C 
WINDC46C 
WINDC49C 
W INDu50C 
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NENTRY  = T AB ( K1 +5 ) 

KI  = K1  + I0 

K2  = 4*NENTRY  + KT+2 

IF  (NENTRY • EQ . 1 ) GO  TO  31 

DO  30  K=K1  » K2  * 4 

IF  (FTIME.GT.TAB(K)  ) GO  TO  30 

KX  = K 

R1  = (TAB(K)-FTIME)/(TAB(K)-TAB(K-4) ) 

GO  TO  32 

30  CONTINUE 

31  KK  = K2 
Rl  = 0.0 

32  R2  = 1.0  - Rl 
DO  33  1=1.3 
K=  KK+I 

33  FT  ( I ) = R2*TAB(K)  ♦ RI^TAB(K-4) 

COMPUTE  PRESENTED  AREA  TO  WIND  FORCE. 

CALL  MAT(D( I. I »M ) ,FT,FF. 3.3.1. 3.3.3) 

CALL  MAT ( B D ( 7 , MM ) .FF.AF ,3,3,1, 3.3.3) 

FAF  = FF(I)*AF(1)  ♦ FF(2)^AF(2)  ♦ FF(3)*AF(3) 

IF  (FAF .LE. 0.0)  GO  TO  99 

TF  = TM(  1 ) *FF  ( I ) ♦ TM(2)*FF(2)  ♦ TM(3)*FF(3) 

BREF  = DSQRT( BTS-TF*TF/FAF) 

SCALE  = (-BET  + BR  EF )/ ( -BTE+BREF ) 

IF  (SCALE. GE. 1.0)  GO  TO  99 
IF  ( SCALE.LT. 0.0)  SCALE  = O.G 

TRACER  = ( BD(  7, MM ) -AF ( 1 )**2 /F AF ) * ( BD( I 1 , MM ) -A F ( 2 ) **2/FAF ) 

* ♦ ( BD(  7,MM)-AF( 1 )**2/F AF )*( BD ( I 5 ,MM ) -AF ( 3 ) **2/FAF ) 

* ♦ ( BD( 1 1 , MM ) — AF ( 2 )»*2/F AF ) * ( BD( 1 5 ,MM ) -AF ( 3 ) **2/F AF ) 

* - ( BD(  6,MM)-AF( 1)»AF(2 )/FAF)**2 

* - (BD(  9,MM)-AF(1)*AF(3)/FAF)«2 

* - ( BD( 12 ,MM) — AF( 2)*AF(3)/FAF )**2 

AREA  * ( I • O-SC ALE**2 ) * PI  / DSQRT ( TRAC ER ) 

ADD  FORCE  AND  TORQUES  TO  UI  AND  U2  ARRAYS  FOR  SEGMENT  M. 

SCALE  = SC  ALE/BTE 
DO  36  1=1,3 

RLM(I)  = RM(I)*SCALE  ♦ BD(I  + 3»MM) 

FT  (I)  = FT ( I ) ♦AREA 
36  FF  ( I ) = FF ( I ) ♦AREA 

CALL  CROSS  ( RLM , FF , TQM ) 

DO  39  1=1,3 

Ul ( I , M ) = U1(I,M)  ♦ FT ( I ) 

39  U2 ( I , M ) = U2 ( I ,M ) ♦ TUM(I) 

IF  (NPRT( 14J.NE.0)  WRITE  (6,41)  T IME,M, P , ARE A, FT, TQM 
41  FORMAT  ( * WIND  F0RCE,,F14*6,I6,2F10.3,3X,3F12.5,3X,3F12.6) 
99  CALL  ELTIME  (2,35) 


WIND051C 
W INDv  520 
WINDC53C 
WIND054C 
W INDC55C 
WINDC56C 
W1NDC570 
WINDC5BC 
W IN  DO  590 
W IND06C0 
WIND0610 
WIND062C 
W1ND0630 
WIND064C 
WINDC65C 
WINDG66C 
WINDC67C 
W 1ND0680 
W IN  DO  690 
W IND0700 
WINDC71C 
WIND0720 
WlNDo73C 
WIND0740 
WIND0750 
WIND0760 
WIND0770 
WIND078G 
WINDQ79C 
WIND0800 
W IN DOB  1C 
WINDC82C 
W1ND0830 
WIND0840 
W IN  DO  8 50 
W IN DC  860 
W IN  DO  870 
WIND0880 
WINC089C 
WIND0900 
WINDC91C 
WIND092C 
WINDC93C 
WIND094C 
W IN  DO 950 
WINDu960 
W INDO  970 
W I N DC  9 8 0 
WINDC990 
WIND1C0C 
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